source: cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.pas@ 1561

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

Upgrade to version 27

File size: 7.1 KB
Line 
1unit fConsMedRslt;
2
3interface
4
5uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
6 Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox,
7 VA508AccessibilityManager;
8
9type
10 TMedResultRec = record
11 Action: string;
12 ResultPtr: string;
13 DateTimeofAction: TFMDateTime;
14 ResponsiblePerson: Int64;
15 AlertsTo: TRecipientList;
16 end;
17
18 TfrmConsMedRslt = class(TfrmAutoSz)
19 cmdOK: TButton;
20 cmdCancel: TButton;
21 lstMedResults: TORListBox;
22 SrcLabel: TLabel;
23 pnlBase: TORAutoPanel;
24 cmdDetails: TButton;
25 ckAlert: TCheckBox;
26 lblDateofAction: TOROffsetLabel;
27 calDateofAction: TORDateBox;
28 lblActionBy: TOROffsetLabel;
29 cboPerson: TORComboBox;
30 lblResultName: TOROffsetLabel;
31 lblResultDate: TOROffsetLabel;
32 lblSummary: TOROffsetLabel;
33 procedure cmdOKClick(Sender: TObject);
34 procedure cmdCancelClick(Sender: TObject);
35 procedure cmdDetailsClick(Sender: TObject);
36 procedure ckAlertClick(Sender: TObject);
37 procedure NewPersonNeedData(Sender: TObject; const StartFrom: String;
38 Direction, InsertAt: Integer);
39 procedure FormDestroy(Sender: TObject);
40 procedure lstMedResultsDrawItem(Control: TWinControl; Index: Integer;
41 Rect: TRect; State: TOwnerDrawState);
42 protected
43 procedure ShowDetailsDestroyed(Sender: TObject);
44 private
45 FShowDetails: TfrmReportBox;
46 FOldShowDetailsOnDestroy: TNotifyEvent;
47 FMedResult: TMedResultRec ;
48 FChanged: Boolean;
49 end;
50
51function SelectMedicineResult(ConsultIEN: integer; FormTitle: string; var MedResult: TMedResultRec): boolean ;
52
53implementation
54
55{$R *.DFM}
56
57uses rConsults, rCore, uCore, uConst;
58
59const
60 TX_MEDRSLT_TEXT = 'Select medicine result or press Cancel.';
61 TX_MEDRSLT_CAP = 'No Result Selected';
62
63var
64 RecipientList: TRecipientList ;
65
66function SelectMedicineResult(ConsultIEN: integer; FormTitle: string; var MedResult: TMedResultRec): boolean ;
67{ displays Medicine Result selection form and returns a record of the selection }
68var
69 frmConsMedRslt: TfrmConsMedRslt;
70begin
71 frmConsMedRslt := TfrmConsMedRslt.Create(Application);
72 try
73 with frmConsMedRslt do
74 begin
75 FChanged := False;
76 FillChar(RecipientList, SizeOf(RecipientList), 0);
77 FillChar(FMedResult, SizeOf(FMedResult), 0);
78 Caption := FormTitle;
79 cboPerson.InitLongList(User.Name);
80 cboPerson.SelectByIEN(User.DUZ);
81 ResizeFormToFont(TForm(frmConsMedRslt));
82
83 if MedResult.Action = 'ATTACH' then
84 begin
85 FastAssign(GetAssignableMedResults(ConsultIEN), lstMedResults.Items);
86 ckAlert.Visible := True;
87 end
88 else if MedResult.Action = 'REMOVE' then
89 begin
90 FastAssign(GetRemovableMedResults(ConsultIEN), lstMedResults.Items);
91 ckAlert.Visible := False;
92 end;
93 if lstMedResults.Items.Count > 0 then
94 ShowModal
95 else
96 FChanged := True;
97 Result := FChanged;
98 MedResult := FMedResult;
99 end; {with frmODConsMedRslt}
100 finally
101 frmConsMedRslt.Release;
102 end;
103end;
104
105procedure TfrmConsMedRslt.cmdCancelClick(Sender: TObject);
106begin
107 FillChar(FMedResult, SizeOf(FMedResult), 0);
108 FChanged := False;
109 Close;
110end;
111
112procedure TfrmConsMedRslt.cmdOKClick(Sender: TObject);
113begin
114 FillChar(FMedResult, SizeOf(FMedResult), 0);
115 if lstMedResults.ItemIndex = -1 then
116 begin
117 InfoBox(TX_MEDRSLT_TEXT, TX_MEDRSLT_CAP, MB_OK or MB_ICONWARNING);
118 FChanged := False ;
119 Exit;
120 end;
121 FChanged := True;
122 with FMedResult do
123 begin
124 ResultPtr := lstMedResults.ItemID ;
125 DateTimeofAction := calDateOfAction.FMDateTime;
126 ResponsiblePerson := cboPerson.ItemIEN;
127 AlertsTo := RecipientList;
128 end;
129 Close;
130end;
131
132procedure TfrmConsMedRslt.cmdDetailsClick(Sender: TObject);
133const
134 TX_RESULTS_CAP = 'Detailed Results Display';
135var
136 x: string;
137 //MsgString, HasImages: string;
138begin
139 inherited;
140 if lstMedResults.ItemIndex = -1 then exit;
141 x := Piece(Piece(Piece(lstMedResults.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstMedResults.ItemID, ';', 1);
142 // ---------------------------------------------------------------
143 // Don't do this until MED API is changed for new/unassigned results, or false '0' will be broadcast
144(* MsgString := 'MED^' + x;
145 HasImages := BOOLCHAR[StrToIntDef(Piece(x, U, 5), 0) > 0];
146 SetPiece(HasImages, U, 10, HasImages);
147 NotifyOtherApps(NAE_REPORT, MsgString);*)
148 // ---------------------------------------------------------------
149 NotifyOtherApps(NAE_REPORT, 'MED^' + x);
150 if(not assigned(FShowDetails)) then
151 begin
152 FShowDetails := ModelessReportBox(GetDetailedMedicineResults(lstMedResults.ItemID), TX_RESULTS_CAP, True);
153 FOldShowDetailsOnDestroy := FShowDetails.OnDestroy;
154 FShowDetails.OnDestroy := ShowDetailsDestroyed;
155 cmdDetails.Enabled := (not assigned(FShowDetails));
156 lstMedResults.Enabled := (not assigned(FShowDetails));
157 end;
158end;
159
160procedure TfrmConsMedRslt.ShowDetailsDestroyed(Sender: TObject);
161begin
162 if(assigned(FOldShowDetailsOnDestroy)) then
163 FOldShowDetailsOnDestroy(Sender);
164 FShowDetails := nil;
165 cmdDetails.Enabled := (not assigned(FShowDetails));
166 lstMedResults.Enabled := (not assigned(FShowDetails));
167end;
168
169
170procedure TfrmConsMedRslt.ckAlertClick(Sender: TObject);
171begin
172 FillChar(RecipientList, SizeOf(RecipientList), 0);
173 if ckAlert.Checked then SelectRecipients(Font.Size, 0, RecipientList) ;
174end;
175
176procedure TfrmConsMedRslt.NewPersonNeedData(Sender: TObject; const StartFrom: string;
177 Direction, InsertAt: Integer);
178begin
179 inherited;
180 (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
181end;
182
183procedure TfrmConsMedRslt.FormDestroy(Sender: TObject);
184begin
185 inherited;
186 KillObj(@FShowDetails);
187end;
188
189procedure TfrmConsMedRslt.lstMedResultsDrawItem(Control: TWinControl;
190 Index: Integer; Rect: TRect; State: TOwnerDrawState);
191var
192 x: string;
193 AnImage: TBitMap;
194const
195 STD_PROC_TEXT = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
196 STD_DATE = 'MMM DD,YY@HH:NNXX';
197begin
198 inherited;
199 AnImage := TBitMap.Create;
200 try
201 with (Control as TORListBox).Canvas do { draw on control canvas, not on the form }
202 begin
203 x := (Control as TORListBox).Items[Index];
204 FillRect(Rect); { clear the rectangle }
205 AnImage.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1');
206 (Control as TORListBox).ItemHeight := HigherOf(TextHeight(x), AnImage.Height);
207 if StrToIntDef(Piece(x, U, 5), 0) > 0 then
208 begin
209 BrushCopy(Bounds(Rect.Left, Rect.Top, AnImage.Width, AnImage.Height),
210 AnImage, Bounds(0, 0, AnImage.Width, AnImage.Height), clRed); {render ImageFlag}
211 end;
212 TextOut(Rect.Left + AnImage.Width, Rect.Top, Piece(x, U, 2));
213 TextOut(Rect.Left + AnImage.Width + TextWidth(STD_PROC_TEXT), Rect.Top, Piece(x, U, 3));
214 TextOut(Rect.Left + AnImage.Width + TextWidth(STD_PROC_TEXT) + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 4));
215 end;
216 finally
217 AnImage.Free;
218 end;
219end;
220
221end.
Note: See TracBrowser for help on using the repository browser.