📄 main.pas
字号:
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fcStatusBar, Menus, ComCtrls, Buttons, ExtCtrls, ImgList, StdCtrls,
wwdblook, ActnList ,DB;
type
TfrmMain = class(TForm)
PopupBed: TPopupMenu;
ppPatientIn: TMenuItem;
ppPatientOut: TMenuItem;
ppBedChange: TMenuItem;
ppBedChangeDept: TMenuItem;
N36: TMenuItem;
ppBedOrderIn: TMenuItem;
ppBedOrderPrint: TMenuItem;
ppFeeCheck: TMenuItem;
N38: TMenuItem;
ppPatientData: TMenuItem;
N14: TMenuItem;
ppOpenGreenpass: TMenuItem;
PopupWard: TPopupMenu;
ppWardLook: TMenuItem;
ppWardLookLargeIcon: TMenuItem;
ppWardLookSmallIcon: TMenuItem;
ppWardLookList: TMenuItem;
ppWardLookReport: TMenuItem;
ppRefresh: TMenuItem;
N41: TMenuItem;
ppWardAdd: TMenuItem;
ppWardSendMsg: TMenuItem;
ppWardMedSt: TMenuItem;
N39: TMenuItem;
ppWardInfo: TMenuItem;
mmMain: TMainMenu;
mmOrder: TMenuItem;
mmBedOrderIn: TMenuItem;
mmOrderPrint: TMenuItem;
N4: TMenuItem;
mmqryOldOrder: TMenuItem;
mmPatient: TMenuItem;
mmPatientIn: TMenuItem;
mmPatientOut: TMenuItem;
mmBedChange: TMenuItem;
mmBedChangeDept: TMenuItem;
N10: TMenuItem;
mmFindPat: TMenuItem;
N47: TMenuItem;
mmPatientData: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
mmWard: TMenuItem;
mmWardAdd: TMenuItem;
J1: TMenuItem;
N1: TMenuItem;
N8: TMenuItem;
N25: TMenuItem;
mmWardMed: TMenuItem;
mmWork: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N2: TMenuItem;
ICU1: TMenuItem;
N3: TMenuItem;
N5: TMenuItem;
mmSys: TMenuItem;
mmSysChangePasswd: TMenuItem;
mmSysExit: TMenuItem;
mmReLogin: TMenuItem;
mmSysHelp: TMenuItem;
mmSysAbort: TMenuItem;
HisMsgBar: TfcStatusBar;
ListViewWard: TListView;
ImageListOther: TImageList;
ImageListSmallBed: TImageList;
ImageListBed: TImageList;
ControlBar1: TControlBar;
ToolPanel: TPanel;
AreaPanel: TPanel;
BtnBedOrderIn: TSpeedButton;
BtnPatientIn: TSpeedButton;
BtnPatientOut: TSpeedButton;
BtnWardSendmsg: TSpeedButton;
BtnRefresh: TSpeedButton;
Label1: TLabel;
MainActionList: TActionList;
InWardAction: TAction;
BedRefreshAction: TAction;
PatientOutAction: TAction;
N6: TMenuItem;
N7: TMenuItem;
N18: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
SendMsgAction: TAction;
OpenOrderAction: TAction;
ppBlankBed: TMenuItem;
ppEmergency: TMenuItem;
ppOutRecall: TMenuItem;
ChgChargeAction: TAction;
N29: TMenuItem;
ppPatBorn: TMenuItem;
BabyBornAction: TAction;
PatientProperty: TAction;
btnPrnOrder: TSpeedButton;
PrnOrderAction: TAction;
N31: TMenuItem;
ppPrnOutNote: TMenuItem;
dbcb_mDeptSub: TwwDBLookupCombo;
BlankBedAction: TAction;
mmInfoQry: TMenuItem;
mmBedProperty: TMenuItem;
ppIncludeRecp: TMenuItem;
ppExcludeRecp: TMenuItem;
OutRecallAction: TAction;
ppLocalWard: TMenuItem;
procedure mmSysExitClick(Sender: TObject);
procedure ListViewWardChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure FormCreate(Sender: TObject);
procedure mmReLoginClick(Sender: TObject);
procedure ListViewWardMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure InWardActionExecute(Sender: TObject);
procedure BedRefreshActionExecute(Sender: TObject);
procedure PatientOutActionExecute(Sender: TObject);
procedure OpenOrderActionExecute(Sender: TObject);
procedure ChgChargeActionExecute(Sender: TObject);
procedure BabyBornActionExecute(Sender: TObject);
procedure PatientPropertyExecute(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ListViewWardDblClick(Sender: TObject);
procedure ListViewWardDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListViewWardDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ListViewWardEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure N31Click(Sender: TObject);
procedure ppEmergencyClick(Sender: TObject);
procedure PrnOrderActionExecute(Sender: TObject);
procedure SendMsgActionExecute(Sender: TObject);
procedure PopupBedPopup(Sender: TObject);
procedure BlankBedActionExecute(Sender: TObject);
procedure mmSysChangePasswdClick(Sender: TObject);
procedure mmBedPropertyClick(Sender: TObject);
procedure mmWardMedClick(Sender: TObject);
procedure ppIncludeRecpClick(Sender: TObject);
procedure ppExcludeRecpClick(Sender: TObject);
procedure mmInfoQryClick(Sender: TObject);
procedure dbcb_mDeptSubCloseUp(Sender: TObject; LookupTable,
FillTable: TDataSet; modified: Boolean);
procedure ppPrnOutNoteClick(Sender: TObject);
procedure OutRecallActionExecute(Sender: TObject);
procedure ppLocalWardClick(Sender: TObject);
private
{ Private declarations }
public
function ChangeBed(SourceBed, TargetBed : String) : Boolean; //换床
procedure PatCheckfee(IsLocalWard :Smallint);
end;
var
frmMain: TfrmMain;
implementation
uses DataModule, HisUtilitis, Login, PatientIn, PatientOut, OrderItem,
ChgCharge, Babyborn, PatiData, PatientAO, QryPrn, PRNDataModule, Sendmsg,
Passwd, bedProperty, WardMed, patdayfeedtl, baseinfo, LeftNote, OutRecall;
{$R *.DFM}
procedure TfrmMain.mmSysExitClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.ListViewWardChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
if Change = ctState then
begin
if ((Item <> nil) and (Item.SubItems.Count >= 2)) then
begin
if StrToInt(Item.SubItems[7]) >= 1 then //如果定义出院的病人
begin
ListViewWard.OnDragDrop := nil;
ListViewWard.OnEndDrag := nil;
ListViewWard.OnDragOver := nil;
end
else
begin
ListViewWard.OnDragDrop := ListViewWardDragDrop;
ListViewWard.OnEndDrag := ListViewWardEndDrag;
ListViewWard.OnDragOver := ListViewWardDragOver;
end;
end;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
with TfrmLogin.Create(Application) do
begin
Reload := 0;
ShowModal; //显示登录窗口 frmLogin
if ( ModalResult = mrOK ) then
begin
Application.ShowMainForm := True; //显示主窗口
DM.SetSystemTime; //设置系统时间
DM.LoadSysParams; //设置系统参数
end
else
begin //用户单击《取消》按钮
Application.ShowMainForm := False; //不显示主窗口
Application.Terminate; //退出程序
end;
Free; //释放登录窗口 frmLogin
Screen.Cursor := crDefault;
end;
end;
procedure TfrmMain.PatCheckfee(IsLocalWard :Smallint);
var
tmpInid :integer;
tmpTimes :Smallint;
begin
tmpInid := 0;
tmpTimes := 0;
if ListViewWard.Selected <> Nil then
begin
tmpInid := StrtoInt(ListViewWard.Selected.SubItems[2]);
tmpTimes:= StrtoInt(ListViewWard.Selected.SubItems[6]);
end else
begin
HisErrorPrompt('没有选中病人！');
SysUtils.Abort;
end;
//首先生成清单日期以前的床位费
with DM.spBedfeecrt do
begin
close;
Params[0].AsInteger := tmpInid;
params[1].AsDate := Date - 1;
ExecProc;
end;
PRN_DM.clr_DayfeeDtl.ExecSQL;
with PRN_DM.qryDayfeeDtl do
begin
Params[0].AsInteger := tmpInid;
Params[1].AsSmallint := tmpTimes;
if (IsLocalWard = 1) then Params[2].AsString := DM.currWardid;
Open;
end;
PRN_DM.bmDayfeeDtl.Execute;
PRN_DM.qryPRN_Patientsub.Close;
PRN_DM.qryPRN_Patientsub.Params[0].AsString := DM.currWardid;
PRN_DM.qryPRN_Patientsub.Open;
PRN_DM.bmPatientSub.Execute;
PRN_DM.bmInvitem.Execute;
try
frmPatDayfeeDtl := TfrmPatDayfeeDtl.Create(Self);
with frmPatDayfeeDtl do
begin
qrlbBillDate.Caption := '清单日期：在住期间';
qryPatDayfeeDtl.Open;
if qryPatDayfeeDtl.RecordCount > 0 then
begin
QuickRep1.Prepare;
QuickRep1.Preview;
end
else
HisInfoPrompt('没有清单明细数据！！');
end;
finally
Screen.Cursor := crDefault;
frmPatDayfeeDtl.qryPatDayfeeDtl.Close;
frmPatDayfeeDtl.Free;
end;
end;
procedure TfrmMain.mmReLoginClick(Sender: TObject);
begin
with TfrmLogin.Create(Application) do
begin
Reload := 1;
ShowModal;
BedRefreshActionExecute(Nil);
free;
end;
end;
function TfrmMain.ChangeBed(SourceBed, TargetBed : String) :Boolean;
begin
if SourceBed = TargetBed then
begin
Result := False;
exit;
end;
try
if DM.ProjHisadt.InTransaction then
DM.ProjHisadt.Commit;
DM.ProjHisadt.StartTransaction;
DM.spchangeBed.Close;
DM.spChangeBed.Params[0].AsString := DM.currWardid;
DM.spChangeBed.Params[1].AsString := SourceBed;
DM.spChangeBed.Params[2].AsString := TargetBed;
DM.spChangeBed.ExecProc;
Result := DM.spChangeBed.Params[3].AsInteger > 0;
DM.spChangeBed.Close;
DM.ProjHisadt.Commit;
except
DM.ProjHisadt.Rollback;
Result := False;
end;
end;
procedure TfrmMain.ListViewWardMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
if ListViewWard.GetItemAt(X ,Y) = Nil then
ListViewWard.OnDblClick := Nil
else begin
DM.currBedNo := ListViewWard.Selected.SubItems[1];
ListViewWard.OnDblClick := ListViewWardDblClick;
end;
end;
if Button = mbRight then
begin
if ListViewWard.GetItemAt(X ,Y) = Nil then
PopupWard.Popup(X + 3, Y + 72)
else begin
DM.currBedNo := ListViewWard.Selected.SubItems[1];
PopupBed.Popup( X + 3,Y + 72);
end;
end;
end;
procedure TfrmMain.InWardActionExecute(Sender: TObject);
begin
with TfrmPatientIn.Create(Self) do
begin
if ListViewWard.Selected <> nil then
DefaultBed := ListViewWard.Selected.SubItems[1];
ShowModal;
btnRefresh.Click;
Free;
end;
end;
procedure TfrmMain.BedRefreshActionExecute(Sender: TObject);
var
ListItem: TListItem;
begin
// Create a ListView item for each image in the ImageList
with ListViewWard do
begin
OnChange := nil;
Items.Clear;
dbcb_mDeptSub.Text := Trim(DM.qryDeptSubDeptName.Value);
with DM.qryWardBed do
begin
if Active then Close;
ParamByName('wardid').AsString := DM.currWardid;
Open;
First;
while not EOF do
begin
ListItem := Items.Add;
if ((FieldByName('inid').isNull) or
(trim(FieldByName('inid').AsString)='')) then
Listitem.Caption := FieldByName('Bed').AsString
else
Listitem.Caption := FieldByName('Bed').AsString + #13
+ FieldByName('name').AsString;
ListItem.SubItems.Add(FieldByName('WardID').AsString); //SubItems[0]
ListItem.SubItems.Add(FieldByName('Bed').AsString); //SubItems[1]
ListItem.SubItems.Add(FieldByName('Inid').AsString); //SubItems[2]
ListItem.SubItems.Add(FieldByName('Name').AsString); //SubItems[3]
case FieldByName('sex').AsInteger of //SubItems[4]
0 : begin ListItem.SubItems.Add('女') end;
1 : begin ListItem.SubItems.Add('男') end;
else begin ListItem.SubItems.Add('') end;
end;
case FieldByName('nurclass').AsInteger of //SubItems[5]
1 : begin ListItem.SubItems.Add('一级') end;
2 : begin ListItem.SubItems.Add('二级') end;
3 : begin ListItem.SubItems.Add('三级') end;
else begin ListItem.SubItems.Add('') end;
end;
ListItem.SubItems.Add(FieldByName('Times').AsString); //SubItems[6]
ListItem.SubItems.Add(FieldByName('Preout').AsString); //SubItems[7]
ListItem.SubItems.Add(FieldByName('DeptNum').AsString); //SubItems[8]
ListItem.SubItems.Add(FieldByName('Payed').AsString); //SubItems[9]
ListItem.SubItems.Add(FieldByName('InDate').AsString); //SubItems[10]
ListItem.SubItems.Add(FieldByName('OutDate').AsString); //SubItems[11]
if ((FieldByName('inid').isNull) or
(trim(FieldByName('inid').AsString)='')) then
ListItem.ImageIndex := 0 //0 表示空床图标
else
begin
if (FieldByName('Sex').AsInteger = 1) then //男性病人
begin
if FieldByName('preout').AsInteger = 1 then
ListItem.ImageIndex := 7 //out
else
case FieldByName('Nurclass').AsInteger of
1 : begin ListItem.ImageIndex := 1 end;//一级护理
2 : begin ListItem.ImageIndex := 2 end;//二级护理
3 : begin ListItem.ImageIndex := 3 end;//三级护理
4 : begin ListItem.ImageIndex := 9 end;
5 : begin ListItem.ImageIndex := 10 end;
6 : begin ListItem.ImageIndex := 13 end;
end;
end
else //女性病人
if (FieldByName('Sex').AsInteger = 0) then
begin
if FieldByName('preout').AsInteger = 1 then
ListItem.ImageIndex := 8 //out
else
case FieldByName('Nurclass').AsInteger of
1 : begin ListItem.ImageIndex := 4 end;//一级护理
2 : begin ListItem.ImageIndex := 5 end;//二级护理
3 : begin ListItem.ImageIndex := 6 end;//三级护理
4 : begin ListItem.ImageIndex := 11 end;
5 : begin ListItem.ImageIndex := 12 end;
6 : begin ListItem.ImageIndex := 14 end;
end;
end;
end;
Next;
end;
Close; //Close qryWardBed
end;
OnChange := ListViewWardChange;
end;
HisMsgBar.Panels[0].Text := DM.currOperatorName;
HisMsgBar.Panels[1].Text := DM.currWardName+'('+DM.currWardid+')';
Caption := '护士工作站管理系统';
ListViewWard.ViewStyle := vsSmallIcon;
ListViewWard.ViewStyle := vsIcon;
frmmain.WindowState := wsmaximized;
end;
procedure TfrmMain.PatientOutActionExecute(Sender: TObject);
begin
try
frmPatientOut := TfrmPatientOut.Create(Self);
if frmPatientOut.ShowModal = mrOK then
BedRefreshActionExecute(Sender);
finally
Screen.Cursor := crDefault;
frmPatientOut.Free;
end;
end;
procedure TfrmMain.OpenOrderActionExecute(Sender: TObject);
begin
OpenOrder; //打开医嘱 ，过程内容在frmOrderItem
end;
procedure TfrmMain.ChgChargeActionExecute(Sender: TObject);
begin
try
frmChgCharge := TfrmChgCharge.Create(Self);
frmChgCharge.ShowModal;
BedRefreshActionExecute(Sender);
finally
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -