source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersOnChart.pas@ 1806

Last change on this file since 1806 was 460, checked in by Kevin Toppenberg, 16 years ago

Uploading from OR_30_258

File size: 5.5 KB
Line 
1unit fOrdersOnChart;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
8
9type
10 TfrmOnChartOrders = class(TfrmAutoSz)
11 Panel2: TPanel;
12 Label1: TLabel;
13 lstOrders: TCaptionListBox;
14 Panel1: TPanel;
15 cmdOK: TButton;
16 cmdCancel: TButton;
17 procedure FormCreate(Sender: TObject);
18 procedure cmdOKClick(Sender: TObject);
19 procedure cmdCancelClick(Sender: TObject);
20 procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
21 var AHeight: Integer);
22 procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
23 Rect: TRect; State: TOwnerDrawState);
24 procedure Panel2Resize(Sender: TObject);
25 private
26 OKPressed: Boolean;
27 end;
28
29function ExecuteOnChartOrders(SelectedList: TList): Boolean;
30
31implementation
32
33{$R *.DFM}
34
35uses rCore, rOrders, uConst, fOrdersPrint, uOrders, fFrame, UCore,
36 fClinicWardMeds;
37
38const
39 TX_SAVERR1 = 'The error, ';
40 TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
41 TC_SAVERR = 'Error Saving Order';
42
43function ExecuteOnChartOrders(SelectedList: TList): Boolean;
44var
45 frmOnChartOrders: TfrmOnChartOrders;
46 i, PrintLoc: Integer;
47 SignList: TStringList;
48 OrderText: string;
49
50 function FindOrderText(const AnID: string): string;
51 var
52 i: Integer;
53 begin
54 Result := '';
55 with SelectedList do for i := 0 to Count - 1 do
56 with TOrder(Items[i]) do if ID = AnID then
57 begin
58 Result := Text;
59 Break;
60 end;
61 end;
62
63begin
64 Result := False;
65 PrintLoc := 0;
66 if SelectedList.Count = 0 then Exit;
67 frmOnChartOrders := TfrmOnChartOrders.Create(Application);
68 try
69 ResizeFormToFont(TForm(frmOnChartOrders));
70 with SelectedList do for i := 0 to Count - 1 do
71 frmOnChartOrders.lstOrders.Items.Add(TOrder(Items[i]).Text);
72 frmOnChartOrders.ShowModal;
73 if frmOnChartOrders.OKPressed then
74 begin
75 Result := True;
76 SignList := TStringList.Create;
77 try
78 with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
79 SignList.Add(ID + U + SS_ONCHART + U + RS_RELEASE + U + NO_WRITTEN);
80 StatusText('Sending Orders to Service(s)...');
81 if SignList.Count > 0 then SendOrders(SignList, '');
82
83 if (not frmFrame.TimedOut) then
84 begin
85 if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
86 frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
87 else
88 if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
89 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
90 end;
91 uCore.TempEncounterLoc := 0;
92 uCore.TempEncounterLocName := '';
93
94 with SignList do if Count > 0 then for i := 0 to Count - 1 do
95 begin
96 if Pos('E', Piece(SignList[i], U, 2)) > 0 then
97 begin
98 OrderText := FindOrderText(Piece(SignList[i], U, 1));
99 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
100 TC_SAVERR, MB_OK);
101 end;
102 end;
103 StatusText('');
104 PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc);
105// SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt); //*KCM*
106// if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo); //*KCM*
107 finally
108 SignList.Free;
109 end;
110 end; {if frmOnChartOrders.OKPressed}
111 finally
112 frmOnChartOrders.Release;
113 with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
114 end;
115end;
116
117procedure TfrmOnChartOrders.FormCreate(Sender: TObject);
118begin
119 inherited;
120 OKPressed := False;
121end;
122
123procedure TfrmOnChartOrders.cmdOKClick(Sender: TObject);
124begin
125 inherited;
126 OKPressed := True;
127 Close;
128end;
129
130procedure TfrmOnChartOrders.cmdCancelClick(Sender: TObject);
131begin
132 inherited;
133 Close;
134end;
135
136procedure TfrmOnChartOrders.lstOrdersMeasureItem(Control: TWinControl;
137 Index: Integer; var AHeight: Integer);
138var
139 x: string;
140 ARect: TRect;
141begin
142 inherited;
143 with lstOrders do if Index < Items.Count then
144 begin
145 ARect := ItemRect(Index);
146 Canvas.FillRect(ARect);
147 x := FilteredString(Items[Index]);
148 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
149 //if AHeight > 255 then AHeight := 255;
150 if AHeight < 13 then AHeight := 15;
151 end;
152end;
153
154procedure TfrmOnChartOrders.lstOrdersDrawItem(Control: TWinControl;
155 Index: Integer; Rect: TRect; State: TOwnerDrawState);
156var
157 x: string;
158 ARect: TRect;
159 SaveColor: TColor;
160begin
161 inherited;
162 with lstOrders do
163 begin
164 ARect := Rect;
165 ARect.Left := ARect.Left + 2;
166 Canvas.FillRect(ARect);
167 Canvas.Pen.Color := clSilver;
168 SaveColor := Canvas.Brush.Color;
169 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
170 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
171 if Index < Items.Count then
172 begin
173 x := FilteredString(Items[Index]);
174 DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
175 Canvas.Brush.Color := SaveColor;
176 ARect.Right := ARect.Right + 4;
177 end;
178 end;
179end;
180
181procedure TfrmOnChartOrders.Panel2Resize(Sender: TObject);
182begin
183 inherited;
184 lstOrders.Invalidate;
185end;
186
187end.
Note: See TracBrowser for help on using the repository browser.