source: cprs/trunk/CPRS-Chart/Orders/fOrdersOnChart.pas@ 830

Last change on this file since 830 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 6.3 KB
Line 
1unit fOrdersOnChart;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
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, rODLab, fRptBox;
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 AList: TStringList;
50
51 function FindOrderText(const AnID: string): string;
52 var
53 i: Integer;
54 begin
55 Result := '';
56 with SelectedList do for i := 0 to Count - 1 do
57 with TOrder(Items[i]) do if ID = AnID then
58 begin
59 Result := Text;
60 Break;
61 end;
62 end;
63
64begin
65 Result := False;
66 PrintLoc := 0;
67 if SelectedList.Count = 0 then Exit;
68 frmOnChartOrders := TfrmOnChartOrders.Create(Application);
69 try
70 ResizeFormToFont(TForm(frmOnChartOrders));
71 with SelectedList do for i := 0 to Count - 1 do
72 frmOnChartOrders.lstOrders.Items.Add(TOrder(Items[i]).Text);
73 frmOnChartOrders.ShowModal;
74 if frmOnChartOrders.OKPressed then
75 begin
76 Result := True;
77 SignList := TStringList.Create;
78 try
79 with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
80 SignList.Add(ID + U + SS_ONCHART + U + RS_RELEASE + U + NO_WRITTEN);
81 StatusText('Sending Orders to Service(s)...');
82 if SignList.Count > 0 then SendOrders(SignList, '');
83
84 if (not frmFrame.TimedOut) then
85 begin
86 if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
87 frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
88 else
89 if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
90 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
91 end;
92 uCore.TempEncounterLoc := 0;
93 uCore.TempEncounterLocName := '';
94
95 with SignList do if Count > 0 then for i := 0 to Count - 1 do
96 begin
97 if Pos('E', Piece(SignList[i], U, 2)) > 0 then
98 begin
99 OrderText := FindOrderText(Piece(SignList[i], U, 1));
100 if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
101 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
102 'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.',
103 TC_SAVERR, MB_OK)
104 else
105 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
106 TC_SAVERR, MB_OK);
107 end;
108 end;
109 StatusText('');
110 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
111 AList := TStringList.Create;
112 try
113 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
114 if AList.Text <> '' then
115 ReportBox(AList, 'Changed Orders', TRUE);
116 finally
117 AList.Free;
118 end;
119 PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc);
120// SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt); //*KCM*
121// if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo); //*KCM*
122 finally
123 SignList.Free;
124 end;
125 end; {if frmOnChartOrders.OKPressed}
126 finally
127 frmOnChartOrders.Release;
128 with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
129 end;
130end;
131
132procedure TfrmOnChartOrders.FormCreate(Sender: TObject);
133begin
134 inherited;
135 OKPressed := False;
136end;
137
138procedure TfrmOnChartOrders.cmdOKClick(Sender: TObject);
139begin
140 inherited;
141 OKPressed := True;
142 Close;
143end;
144
145procedure TfrmOnChartOrders.cmdCancelClick(Sender: TObject);
146begin
147 inherited;
148 Close;
149end;
150
151procedure TfrmOnChartOrders.lstOrdersMeasureItem(Control: TWinControl;
152 Index: Integer; var AHeight: Integer);
153var
154 x: string;
155 ARect: TRect;
156begin
157 inherited;
158 with lstOrders do if Index < Items.Count then
159 begin
160 ARect := ItemRect(Index);
161 Canvas.FillRect(ARect);
162 x := FilteredString(Items[Index]);
163 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
164 if AHeight < 13 then AHeight := 15;
165 end;
166end;
167
168procedure TfrmOnChartOrders.lstOrdersDrawItem(Control: TWinControl;
169 Index: Integer; Rect: TRect; State: TOwnerDrawState);
170var
171 x: string;
172 ARect: TRect;
173 SaveColor: TColor;
174begin
175 inherited;
176 with lstOrders do
177 begin
178 ARect := Rect;
179 ARect.Left := ARect.Left + 2;
180 Canvas.FillRect(ARect);
181 Canvas.Pen.Color := Get508CompliantColor(clSilver);
182 SaveColor := Canvas.Brush.Color;
183 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
184 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
185 if Index < Items.Count then
186 begin
187 x := FilteredString(Items[Index]);
188 DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
189 Canvas.Brush.Color := SaveColor;
190 ARect.Right := ARect.Right + 4;
191 end;
192 end;
193end;
194
195procedure TfrmOnChartOrders.Panel2Resize(Sender: TObject);
196begin
197 inherited;
198 lstOrders.Invalidate;
199end;
200
201end.
Note: See TracBrowser for help on using the repository browser.