source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersOnChart.pas@ 1593

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

Initial upload of TMG-CPRS 1.0.26.69

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