source: cprs/branches/tmg-cprs/CPRS-Chart/fPtCWAD.pas@ 1802

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 3.1 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/25/2007
2unit fPtCWAD;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, ORCtrls, StdCtrls, ORFn, ExtCtrls, DKLang;
9
10type
11 TfrmPtCWAD = class(TfrmAutoSz)
12 lstAllergies: TORListBox;
13 lstNotes: TORListBox;
14 lblNotes: TOROffsetLabel;
15 pnlBottom: TPanel;
16 btnClose: TButton;
17 lblAllergies: TOROffsetLabel;
18 procedure FormCreate(Sender: TObject);
19 procedure lstAllergiesClick(Sender: TObject);
20 procedure lstNotesClick(Sender: TObject);
21 procedure FormKeyUp(Sender: TObject; var Key: Word;
22 Shift: TShiftState);
23 procedure btnCloseClick(Sender: TObject);
24 private
25 { Private declarations }
26 public
27 { Public declarations }
28 end;
29
30procedure ShowCWAD;
31
32implementation
33
34{$R *.DFM}
35
36uses rCover, fRptBox, uCore, uConst, fAllgyBox, rODAllergy;
37
38//const
39//TX_LST_ALLG = 'Searching for allergies...'; <-- original line. //kt 8/25/2007
40//TX_LST_POST = 'Searching for postings...'; <-- original line. //kt 8/25/2007
41
42var
43 TX_LST_ALLG : string; //kt
44 TX_LST_POST : string; //kt
45
46
47procedure SetupVars;
48//kt Added entire function to replace constant declarations 8/25/2007
49begin
50 TX_LST_ALLG := DKLangConstW('fPtCWAD_Searching_for_allergiesxxx');
51 TX_LST_POST := DKLangConstW('fPtCWAD_Searching_for_postingsxxx');
52end;
53
54procedure ShowCWAD;
55{ displays CWAD notices (future - allow updates of allergy info from here? }
56var
57 frmPtCWAD: TfrmPtCWAD;
58begin
59 frmPtCWAD := TfrmPtCWAD.Create(Application);
60 try
61 ResizeFormToFont(TForm(frmPtCWAD));
62 frmPtCWAD.ShowModal;
63 finally
64 frmPtCWAD.Release;
65 end;
66end;
67
68
69procedure TfrmPtCWAD.FormCreate(Sender: TObject);
70var
71 i: Integer;
72begin
73 SetupVars; //kt added 8/25/2007 to replace constants with vars.
74 inherited;
75 StatusText(TX_LST_ALLG);
76 ListAllergies(lstAllergies.Items);
77 StatusText(TX_LST_POST);
78 ListPostings(lstNotes.Items);
79 with lstNotes do for i := Items.Count - 1 downto 0 do
80 if Items[i]='^Allergies^' then Items.Delete(i);
81 StatusText('');
82end;
83
84procedure TfrmPtCWAD.lstAllergiesClick(Sender: TObject);
85begin
86 inherited;
87 with lstAllergies do
88 if ItemIEN > 0 then
89 begin
90{ TODO -oRich V. -cART/Allergy : Allergy Box to update CWAD allergies list? }
91(* if ARTPatchInstalled then
92 AllergyBox(DetailAllergy(ItemIEN), DisplayText[ItemIndex], True, ItemIEN)
93 else*)
94 ReportBox(DetailAllergy(ItemIEN), DisplayText[ItemIndex], True);
95 end;
96end;
97
98procedure TfrmPtCWAD.lstNotesClick(Sender: TObject);
99begin
100 inherited;
101 with lstNotes do
102 if ItemID <> '' then
103 begin
104 NotifyOtherApps(NAE_REPORT, 'TIU^' + lstNotes.ItemID);
105 ReportBox(DetailPosting(ItemID), DisplayText[ItemIndex], True);
106 end;
107end;
108
109procedure TfrmPtCWAD.FormKeyUp(Sender: TObject; var Key: Word;
110 Shift: TShiftState);
111begin
112 inherited;
113 if Key = VK_ESCAPE then
114 begin
115 Key := 0;
116 Close;
117 end;
118end;
119
120procedure TfrmPtCWAD.btnCloseClick(Sender: TObject);
121begin
122 inherited;
123 Close;
124end;
125
126end.
Note: See TracBrowser for help on using the repository browser.