1 | unit fConsultBSt;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults, fBase508Form,
|
---|
8 | VA508AccessibilityManager;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TfrmConsultsByStatus = class(TfrmBase508Form)
|
---|
12 | pnlBase: TORAutoPanel;
|
---|
13 | lblStatus: TLabel;
|
---|
14 | radSort: TRadioGroup;
|
---|
15 | lstStatus: TORListBox;
|
---|
16 | cmdOK: TButton;
|
---|
17 | cmdCancel: TButton;
|
---|
18 | procedure cmdCancelClick(Sender: TObject);
|
---|
19 | procedure cmdOKClick(Sender: TObject);
|
---|
20 | private
|
---|
21 | FChanged: Boolean;
|
---|
22 | FStatus: string;
|
---|
23 | FStatusName: string;
|
---|
24 | FAscending: Boolean;
|
---|
25 | end;
|
---|
26 |
|
---|
27 | TStatusContext = record
|
---|
28 | Changed: Boolean;
|
---|
29 | Status: string;
|
---|
30 | StatusName: string;
|
---|
31 | Ascending: Boolean;
|
---|
32 | end;
|
---|
33 |
|
---|
34 | function SelectStatus(FontSize: Integer; CurrentContext: TSelectContext; var StatusContext: TStatusContext): boolean ;
|
---|
35 |
|
---|
36 | implementation
|
---|
37 |
|
---|
38 | {$R *.DFM}
|
---|
39 |
|
---|
40 | uses rConsults, rCore, uCore;
|
---|
41 |
|
---|
42 | const
|
---|
43 | TX_STAT_TEXT = 'Select a consult status or press Cancel.';
|
---|
44 | TX_STAT_CAP = 'Missing Status';
|
---|
45 |
|
---|
46 | function SelectStatus(FontSize: Integer; CurrentContext: TSelectContext; var StatusContext: TStatusContext): boolean ;
|
---|
47 | { displays Status select form for consults and returns a record of the selection }
|
---|
48 | var
|
---|
49 | frmConsultsByStatus: TfrmConsultsByStatus;
|
---|
50 | W, H, i, j: Integer;
|
---|
51 | CurrentStatus: string;
|
---|
52 | begin
|
---|
53 | frmConsultsByStatus := TfrmConsultsByStatus.Create(Application);
|
---|
54 | try
|
---|
55 | with frmConsultsByStatus do
|
---|
56 | begin
|
---|
57 | Font.Size := FontSize;
|
---|
58 | W := ClientWidth;
|
---|
59 | H := ClientHeight;
|
---|
60 | ResizeToFont(FontSize, W, H);
|
---|
61 | ClientWidth := W; pnlBase.Width := W;
|
---|
62 | ClientHeight := H; pnlBase.Height := H;
|
---|
63 | FChanged := False;
|
---|
64 | with radSort do {if SortConsultsAscending then ItemIndex := 0 else} ItemIndex := 1;
|
---|
65 | FastAssign(SubSetOfStatus, lstStatus.Items);
|
---|
66 | CurrentStatus := CurrentContext.Status;
|
---|
67 | if CurrentStatus <> '' then with lstStatus do
|
---|
68 | begin
|
---|
69 | i := 1;
|
---|
70 | while Piece(CurrentStatus, ',', i) <> '' do
|
---|
71 | begin
|
---|
72 | j := SelectByID(Piece(CurrentStatus, ',', i));
|
---|
73 | if j > -1 then Selected[j] := True;
|
---|
74 | Inc(i);
|
---|
75 | end;
|
---|
76 | end;
|
---|
77 | ShowModal;
|
---|
78 | with StatusContext do
|
---|
79 | begin
|
---|
80 | Changed := FChanged;
|
---|
81 | Status := FStatus;
|
---|
82 | StatusName := FStatusName;
|
---|
83 | Ascending := FAscending;
|
---|
84 | Result := Changed ;
|
---|
85 | end; {with StatusContext}
|
---|
86 | end; {with frmConsultsByStatus}
|
---|
87 | finally
|
---|
88 | frmConsultsByStatus.Release;
|
---|
89 | end;
|
---|
90 | end;
|
---|
91 |
|
---|
92 | procedure TfrmConsultsByStatus.cmdCancelClick(Sender: TObject);
|
---|
93 | begin
|
---|
94 | Close;
|
---|
95 | end;
|
---|
96 |
|
---|
97 | procedure TfrmConsultsByStatus.cmdOKClick(Sender: TObject);
|
---|
98 | var
|
---|
99 | i: integer;
|
---|
100 | begin
|
---|
101 | if lstStatus.SelCount = 0 then
|
---|
102 | begin
|
---|
103 | InfoBox(TX_STAT_TEXT, TX_STAT_CAP, MB_OK or MB_ICONWARNING);
|
---|
104 | Exit;
|
---|
105 | end;
|
---|
106 | FChanged := True;
|
---|
107 | with lstStatus do for i := 0 to Items.Count-1 do if Selected[i] then
|
---|
108 | begin
|
---|
109 | if Piece(Items[i], U, 1) <> '999' then
|
---|
110 | FStatus := FStatus + Piece(Items[i], U, 1) + ','
|
---|
111 | else
|
---|
112 | FStatus := FStatus + Piece(Items[i],U,3) ;
|
---|
113 | FStatusName := FStatusName + DisplayText[i] + ',' ;
|
---|
114 | end;
|
---|
115 | FStatus := Copy(FStatus, 1, Length(FStatus)-1);
|
---|
116 | FStatusName := Copy(FStatusName, 1, Length(FStatusName)-1);
|
---|
117 | FAscending := radSort.ItemIndex = 0;
|
---|
118 | Close;
|
---|
119 | end;
|
---|
120 |
|
---|
121 | end.
|
---|