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

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

Initial Upload of Official WV CPRS 1.0.26.76

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