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

Last change on this file was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28

File size: 6.6 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 //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
96 with SignList do if Count > 0 then for i := 0 to Count - 1 do
97 begin
98 if Pos('E', Piece(SignList[i], U, 2)) > 0 then
99 begin
100 OrderText := FindOrderText(Piece(SignList[i], U, 1));
101 if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
102 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
103 TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
104 else if Piece(SignList[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
105 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
106 TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
107 else
108 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
109 TC_SAVERR, MB_OK);
110 end;
111 end;
112 StatusText('');
113 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
114 AList := TStringList.Create;
115 try
116 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
117 if AList.Text <> '' then
118 ReportBox(AList, 'Changed Orders', TRUE);
119 finally
120 AList.Free;
121 end;
122 PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc);
123// SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt); //*KCM*
124// if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo); //*KCM*
125 finally
126 SignList.Free;
127 end;
128 end; {if frmOnChartOrders.OKPressed}
129 finally
130 frmOnChartOrders.Release;
131 with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
132 end;
133end;
134
135procedure TfrmOnChartOrders.FormCreate(Sender: TObject);
136begin
137 inherited;
138 OKPressed := False;
139end;
140
141procedure TfrmOnChartOrders.cmdOKClick(Sender: TObject);
142begin
143 inherited;
144 OKPressed := True;
145 Close;
146end;
147
148procedure TfrmOnChartOrders.cmdCancelClick(Sender: TObject);
149begin
150 inherited;
151 Close;
152end;
153
154procedure TfrmOnChartOrders.lstOrdersMeasureItem(Control: TWinControl;
155 Index: Integer; var AHeight: Integer);
156var
157 x: string;
158 ARect: TRect;
159begin
160 inherited;
161 with lstOrders do if Index < Items.Count then
162 begin
163 ARect := ItemRect(Index);
164 Canvas.FillRect(ARect);
165 x := FilteredString(Items[Index]);
166 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
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 := Get508CompliantColor(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.