source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fPatientEd.pas@ 1672

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 3.0 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fPatientEd;
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 TfrmPatientEd = class(TfrmPCEBaseMain)
13 lblUnderstanding: TLabel;
14 cboPatUnderstanding: TORComboBox;
15 procedure cboPatUnderstandingChange(Sender: TObject);
16 procedure FormCreate(Sender: TObject);
17 private
18 protected
19 procedure UpdateNewItemStr(var x: string); override;
20 procedure UpdateControls; override;
21 public
22 end;
23
24var
25 frmPatientEd: TfrmPatientEd;
26
27implementation
28
29{$R *.DFM}
30
31uses
32 fEncounterFrame;
33
34{///////////////////////////////////////////////////////////////////////////////
35//Name:procedure tfrmPatientEd.cboPatUnderstandingChange(Sender: TObject);
36//Created: Jan 1999
37//By: Robert Bott
38//Location: ISL
39//Description:Change the level of understanding assigned to the education item.
40///////////////////////////////////////////////////////////////////////////////}
41procedure tfrmPatientEd.cboPatUnderstandingChange(Sender: TObject);
42var
43 i: integer;
44
45begin
46 if(NotUpdating) and (cboPatUnderstanding.Text <> '') then
47 begin
48 for i := 0 to lbGrid.Items.Count-1 do
49 if(lbGrid.Selected[i]) then
50 TPCEPat(lbGrid.Items.Objects[i]).Level := cboPatUnderstanding.ItemID;
51 GridChanged;
52 end;
53end;
54
55procedure TfrmPatientEd.FormCreate(Sender: TObject);
56begin
57 inherited;
58 FTabName := CT_PedNm;
59 FPCEListCodesProc := ListPatientCodes;
60 FPCEItemClass := TPCEPat;
61 FPCECode := 'PED';
62 PCELoadORCombo(cboPatUnderstanding);
63end;
64
65procedure TfrmPatientEd.UpdateNewItemStr(var x: string);
66begin
67 SetPiece(x, U, pnumPEDLevel, NoPCEValue);
68end;
69
70procedure TfrmPatientEd.UpdateControls;
71var
72 ok, First: boolean;
73 SameLOU: boolean;
74 i: integer;
75 LOU: string;
76 Obj: TPCEPat;
77
78begin
79 inherited;
80 if(NotUpdating) then
81 begin
82 BeginUpdate;
83 try
84 ok := (lbGrid.SelCount > 0);
85 lblUnderstanding.Enabled := ok;
86 cboPatUnderstanding.Enabled := ok;
87 if(ok) then
88 begin
89 First := TRUE;
90 SameLOU := TRUE;
91 LOU := NoPCEValue;
92 for i := 0 to lbGrid.Items.Count-1 do
93 begin
94 if lbGrid.Selected[i] then
95 begin
96 Obj := TPCEPat(lbGrid.Items.Objects[i]);
97 if(First) then
98 begin
99 First := FALSE;
100 LOU := Obj.Level;
101 end
102 else
103 begin
104 if(SameLOU) then
105 SameLOU := (LOU = Obj.Level);
106 end;
107 end;
108 end;
109 if(SameLOU) then
110 cboPatUnderstanding.SelectByID(LOU)
111 else
112 cboPatUnderstanding.Text := '';
113 end
114 else
115 begin
116 cboPatUnderstanding.Text := '';
117 end;
118 finally
119 EndUpdate;
120 end;
121 end;
122end;
123
124end.
Note: See TracBrowser for help on using the repository browser.