source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsMedRslt.pas@ 1619

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

Initial upload of TMG-CPRS 1.0.26.69

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