source: cprs/trunk/CPRS-Chart/fPatientFlagMulti.pas@ 820

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

Initial Upload of Official WV CPRS 1.0.26.76

File size: 5.9 KB
Line 
1unit fPatientFlagMulti;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, fAutoSz, ORCtrls, ExtCtrls, ComCtrls, rMisc;
8
9type
10 {This object holds a List of Notes Linked to a PRF as Returned VIA the RPCBroker}
11 TPRFNotes = class(TObject)
12 private
13 FPRFNoteList : TStringList;
14 public
15 //procedure to show the Notes in a ListView, requires a listview parameter
16 procedure ShowActionsOnList(DisplayList : TCaptionListView);
17 //procedure to load the notes, this will call the RPC
18 procedure Load(TitleIEN : Int64; DFN : String);
19 function getNoteIEN(index: integer): String;
20 constructor create;
21 destructor Destroy(); override;
22 end;
23
24 TfrmFlags = class(TForm)
25 Splitter1: TSplitter;
26 pnlTop: TORAutoPanel;
27 lblFlags: TLabel;
28 lstFlags: TORListBox;
29 memFlags: TRichEdit;
30 pnlNotes: TPanel;
31 lvPRF: TCaptionListView;
32 lblNoteTitle: TLabel;
33 Splitter2: TSplitter;
34 pnlBottom: TORAutoPanel;
35 btnClose: TButton;
36 procedure lstFlagsClick(Sender: TObject);
37 procedure FormKeyDown(Sender: TObject; var Key: Word;
38 Shift: TShiftState);
39 procedure FormShow(Sender: TObject);
40 procedure FormCreate(Sender: TObject);
41 procedure FormClose(Sender: TObject; var Action: TCloseAction);
42 procedure FormDestroy(Sender: TObject);
43 procedure lvPRFClick(Sender: TObject);
44 procedure lvPRFKeyDown(Sender: TObject; var Key: Word;
45 Shift: TShiftState);
46 private
47 FFlagID: integer;
48 FPRFNotes : TPRFNotes;
49 FNoteTitle: String;
50 procedure GetNotes();
51 public
52 { Public declarations }
53 end;
54const
55 HIDDEN_COL = 'Press enter or space bar to view this note:';
56 //TIU GET LINKED PRF NOTES, return position constants
57 NOTE_IEN_POS = 1;
58 ACTION_POS = 2;
59 NOTE_DATE_POS = 3;
60 AUTHOR_POS = 4;
61 //TIU GET PRF TITLE, return position constants
62 NOTE_TITLE_IEN = 1;
63 NOTE_TITLE = 2;
64
65
66procedure ShowFlags(FlagId: integer = 0);
67
68implementation
69
70uses uCore,uOrPtf,ORFn, ORNet, uConst, fRptBox, rCover;
71{$R *.dfm}
72
73procedure ShowFlags(FlagId: integer);
74var
75 frmFlags: TfrmFlags;
76begin
77 frmFlags := TFrmFlags.Create(Nil);
78 try
79 SetFormPosition(frmFlags);
80 if HasFlag then
81 begin
82 //SetFormPosition(frmFlags);
83 frmFlags.FFlagID := FlagId;
84 frmFlags.lstFlags.Items.Assign(FlagList);
85 frmFlags.memFlags.SelStart := 0;
86 ResizeFormToFont(TForm(frmFlags));
87 frmFlags.ShowModal;
88 end
89 finally
90 frmFlags.Release;
91 end;
92end;
93
94procedure TfrmFlags.lstFlagsClick(Sender: TObject);
95var
96 FlagArray: TStringList;
97begin
98 if lstFlags.ItemIndex >= 0 then
99 begin
100 FlagArray := TStringList.Create;
101 GetActiveFlg(FlagArray, Patient.DFN, lstFlags.ItemID);
102 if FlagArray.Count > 0 then
103 memFlags.Lines.Assign(FlagArray);
104 memFlags.SelStart := 0;
105 GetNotes;
106 end;
107end;
108
109procedure TfrmFlags.FormKeyDown(Sender: TObject; var Key: Word;
110 Shift: TShiftState);
111begin
112 if Key = VK_ESCAPE then
113 Close;
114end;
115
116
117procedure TfrmFlags.FormShow(Sender: TObject);
118var
119 idx: integer;
120begin
121 inherited;
122 SetFormPosition(Self);
123 idx := 0;
124 if FFlagID > 0 then idx := lstFlags.SelectByIEN(FFlagId);
125 lstFlags.ItemIndex := idx;
126 lstFlagsClick(Self);
127 ActiveControl := memFlags;
128 GetNotes;
129end;
130
131procedure TfrmFlags.FormCreate(Sender: TObject);
132begin
133 inherited;
134 FFlagID := 0;
135end;
136
137procedure TfrmFlags.FormClose(Sender: TObject; var Action: TCloseAction);
138begin
139 inherited;
140 SaveUserBounds(Self);
141end;
142
143procedure TfrmFlags.GetNotes;
144var
145 NoteTitleIEN, FlagID : Int64;
146begin
147 if FPRFNotes = nil then
148 FPRFNotes := TPRFNotes.Create;
149 FlagID := lstFlags.ItemID;
150 CallV('TIU GET PRF TITLE', [Patient.DFN,FlagID]);
151 FNoteTitle := Piece(RPCBrokerV.Results[0],U,NOTE_TITLE);
152 lblNoteTitle.Caption := 'Signed, Linked Notes of Title: '+ FNoteTitle;
153 NoteTitleIEN := StrToInt(Piece(RPCBrokerV.Results[0],U,NOTE_TITLE_IEN));
154 FPRFNotes.Load(NoteTitleIEN,Patient.DFN);
155 FPRFNotes.ShowActionsOnList(lvPRF);
156 with lvPRF do begin
157
158 Columns.BeginUpdate;
159 Columns.EndUpdate;
160 end;
161end;
162
163{ TPRFNotes }
164
165constructor TPRFNotes.create;
166begin
167 inherited;
168 FPRFNoteList := TStringList.create;
169end;
170
171destructor TPRFNotes.Destroy;
172begin
173 FPRFNoteList.Free;
174 inherited;
175end;
176
177function TPRFNotes.getNoteIEN(index: integer): String;
178begin
179 Result := Piece(FPRFNoteList[index],U,NOTE_IEN_POS);
180end;
181
182procedure TPRFNotes.Load(TitleIEN: Int64; DFN: String);
183const
184 REVERSE_CHRONO = 1;
185begin
186 CallV('TIU GET LINKED PRF NOTES', [DFN,TitleIEN,REVERSE_CHRONO]);
187 FPRFNoteList.Assign(RPCBrokerV.Results);
188end;
189
190procedure TPRFNotes.ShowActionsOnList(DisplayList: TCaptionListView);
191var
192 i : integer;
193 ListItem: TListItem;
194begin
195 DisplayList.Clear;
196 for i := 0 to FPRFNoteList.Count-1 do
197 begin
198 //Caption="Text for Screen Reader" SubItem1=Flag SubItem2=Date SubItem3=Action SubItem4=Note
199 ListItem := DisplayList.Items.Add;
200 ListItem.Caption := HIDDEN_COL; //Screen readers don't read the first column title on a listview.
201 ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,NOTE_DATE_POS));
202 ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,ACTION_POS));
203 ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,AUTHOR_POS));
204 end;
205end;
206
207procedure TfrmFlags.FormDestroy(Sender: TObject);
208begin
209 FPRFNotes.Free;
210end;
211
212procedure TfrmFlags.lvPRFClick(Sender: TObject);
213begin
214 if lvPRF.ItemIndex > -1 then
215 begin
216 NotifyOtherApps(NAE_REPORT, 'TIU^' + FPRFNotes.getNoteIEN(lvPRF.ItemIndex));
217 ReportBox(DetailPosting(FPRFNotes.getNoteIEN(lvPRF.ItemIndex)), FNoteTitle, True);
218 end;
219end;
220
221procedure TfrmFlags.lvPRFKeyDown(Sender: TObject; var Key: Word;
222 Shift: TShiftState);
223begin
224 if (Key = VK_SPACE) or (Key = VK_RETURN) then
225 lvPRFClick(Sender);
226end;
227
228end.
Note: See TracBrowser for help on using the repository browser.