source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fImmunization.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: 4.4 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fImmunization;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
9 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, DKLang;
10
11type
12 TfrmImmunizations = class(TfrmPCEBaseMain)
13 lblReaction: TLabel;
14 lblSeries: TLabel;
15 cboImmReaction: TORComboBox;
16 cboImmSeries: TORComboBox;
17 ckbContra: TCheckBox;
18 lblContra: TLabel;
19
20 procedure cboImmSeriesChange(Sender: TObject);
21 procedure cboImmReactionChange(Sender: TObject);
22 procedure ckbContraClick(Sender: TObject);
23 procedure FormCreate(Sender: TObject);
24 private
25 protected
26 procedure UpdateNewItemStr(var x: string); override;
27 procedure UpdateControls; override;
28 public
29// procedure ChangeProvider;
30 end;
31
32var
33 frmImmunizations: TfrmImmunizations;
34
35implementation
36
37{$R *.DFM}
38
39uses
40 fEncounterFrame;
41
42procedure TfrmImmunizations.cboImmSeriesChange(Sender: TObject);
43var
44 i: integer;
45
46begin
47 if(NotUpdating) and (cboImmSeries.Text <> '') then
48 begin
49 for i := 0 to lbGrid.Items.Count-1 do
50 if(lbGrid.Selected[i]) then
51 TPCEImm(lbGrid.Items.Objects[i]).Series := cboImmSeries.ItemID;
52 GridChanged;
53 end;
54end;
55
56procedure TfrmImmunizations.cboImmReactionChange(Sender: TObject);
57var
58 i: integer;
59
60begin
61 if(NotUpdating) and (cboImmReaction.Text <> '') then
62 begin
63 for i := 0 to lbGrid.Items.Count-1 do
64 if(lbGrid.Selected[i]) then
65 TPCEImm(lbGrid.Items.Objects[i]).Reaction := cboImmReaction.ItemID;
66 GridChanged;
67 end;
68end;
69
70procedure TfrmImmunizations.ckbContraClick(Sender: TObject);
71var
72 i: integer;
73
74begin
75 if(NotUpdating) then
76 begin
77 for i := 0 to lbGrid.Items.Count-1 do
78 if(lbGrid.Selected[i]) then
79 TPCEImm(lbGrid.Items.Objects[i]).Contraindicated := ckbContra.Checked;
80 GridChanged;
81 end;
82end;
83
84procedure TfrmImmunizations.FormCreate(Sender: TObject);
85begin
86 inherited;
87 FTabName := CT_ImmNm;
88 FPCEListCodesProc := ListImmunizCodes;
89 FPCEItemClass := TPCEImm;
90 FPCECode := 'IMM';
91 PCELoadORCombo(cboImmReaction);
92 PCELoadORCombo(cboImmSeries);
93end;
94
95procedure TfrmImmunizations.UpdateNewItemStr(var x: string);
96begin
97 inherited;
98 SetPiece(x, U, pnumImmSeries, NoPCEValue);
99 SetPiece(x, U, pnumImmReaction, NoPCEValue);
100 SetPiece(x, U, pnumImmRefused, '0');
101 SetPiece(x, U, pnumImmContra, '0');
102end;
103
104procedure TfrmImmunizations.UpdateControls;
105var
106 ok, Contra, First: boolean;
107 SameS, SameR, SameC: boolean;
108 i: integer;
109 Ser, React: string;
110 Obj: TPCEImm;
111
112begin
113 inherited;
114 if(NotUpdating) then
115 begin
116 BeginUpdate;
117 try
118 ok := (lbGrid.SelCount > 0);
119 lblSeries.Enabled := ok;
120 lblReaction.Enabled := ok;
121 cboImmSeries.Enabled := ok;
122 cboImmReaction.Enabled := ok;
123 ckbContra.Enabled := ok;
124 if(ok) then
125 begin
126 First := TRUE;
127 SameS := TRUE;
128 SameR := TRUE;
129 SameC := TRUE;
130 Contra := FALSE;
131 Ser := NoPCEValue;
132 React := NoPCEValue;
133 for i := 0 to lbGrid.Items.Count-1 do
134 begin
135 if lbGrid.Selected[i] then
136 begin
137 Obj := TPCEImm(lbGrid.Items.Objects[i]);
138 if(First) then
139 begin
140 First := FALSE;
141 Contra := Obj.Contraindicated;
142 Ser := Obj.Series;
143 React := Obj.Reaction;
144 end
145 else
146 begin
147 if(SameS) then
148 SameS := (Ser = Obj.Series);
149 if(SameR) then
150 SameR := (React = Obj.Reaction);
151 if(SameC) then
152 SameC := (Contra = Obj.Contraindicated);
153 end;
154 end;
155 end;
156 if(SameS) then
157 cboImmSeries.SelectByID(Ser)
158 else
159 cboImmSeries.Text := '';
160 if(SameR) then
161 cboImmReaction.SelectByID(React)
162 else
163 cboImmReaction.Text := '';
164 if(SameC) then
165 ckbContra.Checked := Contra
166 else
167 ckbContra.State := cbGrayed;
168 end
169 else
170 begin
171 cboImmSeries.Text := '';
172 cboImmReaction.Text := '';
173 ckbContra.Checked := FALSE;
174 end;
175 finally
176 EndUpdate;
177 end;
178 end;
179end;
180
181end.
182
Note: See TracBrowser for help on using the repository browser.