source: cprs/branches/foia-cprs/CPRS-Chart/fCover.pas@ 459

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

Adding foia-cprs branch
File size: 29.0 KB
Line 
1unit fCover;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fPage, StdCtrls, ORCtrls, ExtCtrls, rOrders, ORClasses, Menus, rCover, fAllgyBox; {REV}
8
9type
10 TfrmCover = class(TfrmPage)
11 pnlBase: TPanel;
12 pnlTop: TPanel;
13 pnlNotTheBottom: TPanel;
14 pnlMiddle: TPanel;
15 pnlBottom: TPanel;
16 sptTop: TSplitter;
17 sptBottom: TSplitter;
18 pnl_Not3: TPanel;
19 pnl_Not8: TPanel;
20 pnl_4: TPanel;
21 pnl_5: TPanel;
22 pnl_6: TPanel;
23 pnl_7: TPanel;
24 pnl_8: TPanel;
25 spt_3: TSplitter;
26 spt_4: TSplitter;
27 spt_5: TSplitter;
28 pnl_1: TPanel;
29 pnl_2: TPanel;
30 pnl_3: TPanel;
31 spt_1: TSplitter;
32 spt_2: TSplitter;
33 lbl_1: TOROffsetLabel;
34 lbl_2: TOROffsetLabel;
35 lbl_4: TOROffsetLabel;
36 lbl_5: TOROffsetLabel;
37 lbl_6: TOROffsetLabel;
38 lbl_7: TOROffsetLabel;
39 lbl_8: TOROffsetLabel;
40 lst_1: TORListBox;
41 lst_2: TORListBox;
42 lst_4: TORListBox;
43 lst_5: TORListBox;
44 lst_6: TORListBox;
45 lst_7: TORListBox;
46 lst_8: TORListBox;
47 timPoll: TTimer;
48 popMenuAllergies: TPopupMenu;
49 popNewAllergy: TMenuItem;
50 popNKA: TMenuItem;
51 popEditAllergy: TMenuItem;
52 popEnteredInError: TMenuItem;
53 pnlFlag: TPanel;
54 lstFlag: TORListBox;
55 lblFlag: TOROffsetLabel;
56 lbl_3: TOROffsetLabel;
57 lst_3: TORListBox;
58 sptFlag: TSplitter;
59 procedure CoverItemClick(Sender: TObject);
60 procedure timPollTimer(Sender: TObject);
61 procedure FormClose(Sender: TObject; var Action: TCloseAction);
62 procedure RemContextPopup(Sender: TObject; MousePos: TPoint;
63 var Handled: Boolean);
64 procedure FormCreate(Sender: TObject);
65 procedure FormDestroy(Sender: TObject);
66 procedure sptBottomCanResize(Sender: TObject; var NewSize: Integer;
67 var Accept: Boolean);
68 procedure sptTopCanResize(Sender: TObject; var NewSize: Integer;
69 var Accept: Boolean);
70 procedure spt_1CanResize(Sender: TObject; var NewSize: Integer;
71 var Accept: Boolean);
72 procedure spt_2CanResize(Sender: TObject; var NewSize: Integer;
73 var Accept: Boolean);
74 procedure spt_3CanResize(Sender: TObject; var NewSize: Integer;
75 var Accept: Boolean);
76 procedure spt_4CanResize(Sender: TObject; var NewSize: Integer;
77 var Accept: Boolean);
78 procedure spt_5CanResize(Sender: TObject; var NewSize: Integer;
79 var Accept: Boolean);
80 procedure popMenuAllergiesPopup(Sender: TObject);
81 procedure popNewAllergyClick(Sender: TObject);
82 procedure popNKAClick(Sender: TObject);
83 procedure popEditAllergyClick(Sender: TObject);
84 procedure popEnteredInErrorClick(Sender: TObject);
85 procedure CoverItemExit(Sender: TObject);
86 procedure lstFlagClick(Sender: TObject);
87 procedure lstFlagKeyDown(Sender: TObject; var Key: Word;
88 Shift: TShiftState);
89 private
90 FCoverList: TCoverSheetList;
91 popReminders: TORPopupMenu;
92 FLoadingForDFN: string; //*DFN*
93 procedure RemindersChange(Sender: TObject);
94 procedure GetPatientFlag;
95 procedure LoadList(const StsTxt: string; ListCtrl: TObject;
96 ARpc: String; ACase, AInvert: Boolean; ADatePiece: integer; ADateFormat, AParam1, AID, ADetail: String; Reminders: boolean = FALSE);
97 public
98 procedure ClearPtData; override;
99 procedure DisplayPage; override;
100 procedure SetFontSize(NewFontSize: Integer); override;
101 procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override; {REV}
102 procedure UpdateAllergiesList;
103 end;
104
105var
106 frmCover: TfrmCover;
107
108const
109 CoverSplitters1 = 'frmCoverSplitters1';
110 CoverSplitters2 = 'frmCoverSplitters2';
111
112implementation
113
114{$R *.DFM}
115
116uses ORNet, ORFn, fRptBox, fVitals, fvit, fFrame, uCore, TRPCB, uConst,
117 uReminders, rReminders, fARTAllgy, uOrPtf, fPatientFlagMulti, rODAllergy;
118
119const
120 TAG_PROB = 10;
121 TAG_ALLG = 20;
122 TAG_POST = 30;
123 TAG_MEDS = 40;
124 TAG_RMND = 50;
125 TAG_LABS = 60;
126 TAG_VITL = 70;
127 TAG_VSIT = 80;
128 RemID = '50';
129
130 TX_INACTIVE_CODE = 'This problem references an ICD code that is not currently active.' + #13#10 +
131 'Please correct this code using the ''Problems'' tab.';
132 TC_INACTIVE_CODE = 'Inactive ICD code';
133
134var
135 uIPAddress: string;
136 uARTCoverSheetParams: string;
137
138procedure TfrmCover.ClearPtData;
139{ clears all lists displayed on the cover sheet }
140begin
141 timPoll.Enabled := False;
142 if Length(FLoadingForDFN) > 0 then StopCoverSheet(FLoadingForDFN, uIPAddress, frmFrame.Handle); //*DFN*
143 FLoadingForDFN := ''; //*DFN*
144 inherited ClearPtData;
145 lst_1.Clear;
146 lst_2.Clear;
147 lst_3.Clear;
148 lst_4.Clear;
149 lst_5.Clear;
150 lst_6.Clear;
151 lst_7.Clear;
152 lst_8.Clear;
153 pnl_1.Visible := false;
154 pnl_2.Visible := false;
155 pnl_3.Visible := false;
156 pnl_4.Visible := false;
157 pnl_5.Visible := false;
158 pnl_6.Visible := false;
159 pnl_7.Visible := false;
160 pnl_8.Visible := false;
161end;
162
163procedure TfrmCover.LoadList(const StsTxt: string; ListCtrl: TObject;
164 ARpc: String; ACase, AInvert: Boolean; ADatePiece: integer; ADateFormat, AParam1, AID, ADetail: String; Reminders: boolean = FALSE);
165begin
166 StatusText(StsTxt);
167 if(ListCtrl is TORListBox) then
168 begin
169 ListGeneric((ListCtrl as TORListBox).Items, ARpc, ACase, AInvert, ADatePiece, ADateFormat, AParam1, ADetail, AID);
170 if((ListCtrl as TORListBox).Items.Count = 0) then
171 (ListCtrl as TORListBox).Items.Add(NoDataText(Reminders));
172 end
173 else
174 begin
175 ListGeneric(ListCtrl as TStrings, ARpc, ACase, AInvert, ADatePiece, ADateFormat, AParam1, ADetail, AID);
176 if((ListCtrl as TStrings).Count = 0) then
177 (ListCtrl as TStrings).Add(NoDataText(Reminders));
178 end;
179 StatusText('');
180end;
181
182procedure TfrmCover.DisplayPage;
183{ loads the cover sheet lists if the patient has just been selected }
184var
185 DontDo, ForeGround: string;
186 WaitCount: Integer;
187 RemSL: TStringList;
188 uCoverSheetList: TStringList;
189 i, iRem: Integer;
190 aIFN, aRPC, aCase, aInvert, aDatePiece, aDateFormat, aTextColor, aStatus, aParam1, aID, aQualifier, aTabPos, aName, aPiece, aDetail, x: string;
191 bCase, bInvert: Boolean;
192 iDatePiece: Integer;
193
194(* procedure LoadList(const StsTxt: string; ListCtrl: TObject;
195 ARpc: String; ACase, AInvert: Boolean; ADatePiece: integer; ADateFormat, AParam1, AID, ADetail: String; Reminders: boolean = FALSE);
196 begin
197 StatusText(StsTxt);
198 if(ListCtrl is TORListBox) then
199 begin
200 ListGeneric((ListCtrl as TORListBox).Items, ARpc, ACase, AInvert, ADatePiece, ADateFormat, AParam1, ADetail, AID);
201 if((ListCtrl as TORListBox).Items.Count = 0) then
202 (ListCtrl as TORListBox).Items.Add(NoDataText(Reminders));
203 end
204 else
205 begin
206 ListGeneric(ListCtrl as TStrings, ARpc, ACase, AInvert, ADatePiece, ADateFormat, AParam1, ADetail, AID);
207 if((ListCtrl as TStrings).Count = 0) then
208 (ListCtrl as TStrings).Add(NoDataText(Reminders));
209 end;
210 StatusText('');
211 end;*)
212
213 procedure WaitList(ListCtrl: TORListBox);
214 begin
215 ListCtrl.Clear;
216 Inc(WaitCount);
217 ListCtrl.Items.Add('0^Retrieving in background...');
218 ListCtrl.Repaint;
219 end;
220
221begin
222 inherited DisplayPage;
223 iRem := -1;
224 frmFrame.mnuFilePrintSetup.Enabled := True;
225 if InitPage then
226 uIPAddress := DottedIPStr;
227 if InitPatient then
228 begin
229 WaitCount := 0;
230 if InteractiveRemindersActive then
231 begin
232 if(InitialRemindersLoaded) then
233 begin
234 DontDo := RemID+';';
235 NotifyWhenRemindersChange(RemindersChange);
236 end
237 else
238 begin
239 DontDo := '';
240 RemoveNotifyRemindersChange(RemindersChange);
241 end;
242 end;
243 ForeGround := StartCoverSheet(uIPAddress, frmFrame.Handle,
244 DontDo, InteractiveRemindersActive);
245 uCoverSheetList := TStringList.Create;
246 LoadCoverSheetList(uCoverSheetList);
247 for i := 0 to uCoverSheetList.Count - 1 do
248 begin
249 x := uCoverSheetList[i];
250 aName := Piece(x,'^',2);
251 aRPC := Piece(x,'^',6);
252 aCase := Piece(x,'^',7);
253 aInvert := Piece(x,'^',8);
254 aDatePiece := Piece(x,'^',11);
255 aDateFormat := Piece(x,'^',10);
256 aTextColor := Piece(x,'^',9);
257 aStatus := 'Searching for ' + Piece(x,'^',2) + '...';
258 aParam1 := Piece(x,'^',12);
259 aID := Piece(x,'^',1); //TAG_PROB, TAG_RMND, ETC.
260 aQualifier := Piece(x,'^',13);
261 aTabPos := Piece(x,'^',14);
262 aPiece := Piece(x,'^',15);
263 aDetail := Piece(x,'^',16);
264 aIFN := Piece(x,'^',17);
265 bCase := FALSE;
266 bInvert := FALSE;
267 iDatePiece := 0;
268 if aCase = '1' then bCase := TRUE;
269 if aInvert = '1' then bInvert := TRUE;
270 if Length(aDatePiece) > 0 then iDatePiece := StrToInt(aDatePiece);
271 if Length(aTextColor) > 0 then aTextColor := 'cl' + aTextColor;
272 // Assign properties to components
273 FCoverList.CVlbl(i).Caption := aName;
274 FCoverList.CVlst(i).Caption := aName;
275 if Length(aTabPos) > 0 then FCoverList.CVlst(i).TabPositions := aTabPos;
276 if Length(aTextColor) > 0 then FCoverList.CVlst(i).Font.Color := StringToColor(aTextColor);
277 if Length(aPiece) > 0 then FCoverList.CVlst(i).Pieces := aPiece;
278 FCoverList.CVlst(i).Tag := StrToInt(aID);
279 if(aID <> RemID) then
280 begin
281 if((aID = '20') or (Pos(aID + ';', ForeGround) > 0)) then
282 LoadList(aStatus, FCoverList.CVlst(i), aRpc, bCase, bInvert, iDatePiece, aDateFormat, aParam1, aID, aDetail)
283 else
284 Waitlist(FCoverList.CVlst(i));
285 if (aID = '20') and ARTPatchInstalled then with FCoverList.CVlst(i) do
286 begin
287 uARTCoverSheetParams := x;
288 PopupMenu := popMenuAllergies;
289 RightClickSelect := True;
290 popMenuAllergies.PopupComponent := FCoverList.CVlst(i);
291 end;
292 end;
293 FCoverList.CVpln(i).Visible := true;
294 if aID = RemID then
295 begin
296 FCoverList.CVLst(i).OnContextPopup := RemContextPopup;
297 FCoverList.CVlst(i).RightClickSelect := True;
298 iRem := FCoverList.CVlst(i).ComponentIndex;
299 if InteractiveRemindersActive then
300 begin
301 if(InitialRemindersLoaded) then
302 CoverSheetRemindersInBackground := FALSE
303 else
304 begin
305 InitialRemindersLoaded := TRUE;
306 CoverSheetRemindersInBackground := (Pos(aID + ';', ForeGround) = 0);
307 if(not CoverSheetRemindersInBackground) then
308 begin
309 //InitialRemindersLoaded := TRUE;
310 RemSL := TStringList.Create;
311 try
312 LoadList(aStatus, RemSL, aRpc, bCase, bInvert, iDatePiece, aDateFormat, aParam1, aID, aDetail);
313 RemindersEvaluated(RemSL);
314 finally;
315 RemSL.Free;
316 end;
317 NotifyWhenRemindersChange(RemindersChange);
318 end
319 else
320 Waitlist(FCoverList.CVlst(i));
321 end;
322 end
323 else
324 if Pos(aID + ';', ForeGround) > 0 then
325 LoadList(aStatus, FCoverList.CVlst(i), aRpc, bCase, bInvert, iDatePiece, aDateFormat, aParam1, aID, aDetail, TRUE)
326 else
327 Waitlist(FCoverList.CVlst(i));
328 if WaitCount > 0 then
329 begin
330 FLoadingForDFN := Patient.DFN;
331 timPoll.Enabled := True;
332 end
333 else FLoadingForDFN := ''; //*DFN*
334 if InteractiveRemindersActive then
335 begin
336 RemindersStarted := TRUE;
337 LoadReminderData(CoverSheetRemindersInBackground);
338 end;
339 end;
340 if WaitCount > 0 then
341 begin
342 FLoadingForDFN := Patient.DFN;
343 timPoll.Enabled := True;
344 end
345 else FLoadingForDFN := ''; //*DFN*
346 end;
347 FocusFirstControl;
348 spt_2.Left := pnl_Not3.Left + pnl_Not3.Width;
349 spt_5.Left := pnl_Not8.Left + pnl_Not8.Width;
350 GetPatientFlag;
351 end;
352 if InitPage then
353 begin
354 popReminders := TORPopupMenu.Create(Self);
355 if InteractiveRemindersActive then
356 begin
357 SetReminderPopupCoverRoutine(popReminders);
358 if iRem > -1 then
359 (frmCover.Components[iRem] as TORListBox).PopupMenu := popReminders;
360 end
361 else
362 begin
363 if iRem > -1 then
364 begin
365 (frmCover.Components[iRem] as TORListBox).RightClickSelect := FALSE;
366 (frmCover.Components[iRem] as TORListBox).OnMouseUp := nil;
367 end;
368 end;
369 end;
370end;
371
372procedure TfrmCover.SetFontSize(NewFontSize: Integer);
373var
374 i: integer;
375begin
376 inherited;
377 with frmCover do
378 for i := ComponentCount - 1 downto 0 do
379 begin
380 if Components[i] is TORListBox then
381 begin
382 case Components[i].Tag of
383 30: (Components[i] as TORListBox).Font.Size := NewFontSize;
384 end;
385 end;
386 end;
387end;
388
389procedure TfrmCover.CoverItemClick(Sender: TObject);
390{ displays details for an item that has been clicked on the cover sheet }
391var
392 i: integer;
393 aDetail: string;
394begin
395 inherited;
396 with TORListBox(Sender) do
397 begin
398 aDetail := Uppercase(Piece(TORListBox(Sender).Items[TORListBox(Sender).ItemIndex],'^',12));
399 case Tag of
400 TAG_PROB:
401 if ItemIEN > 0 then
402 begin
403 i := ItemIndex;
404 if Piece(Items[ItemIndex], U, 13) = '#' then
405 InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
406 ItemIndex := i;
407 ReportBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True);
408 end;
409 TAG_ALLG:
410{ TODO -oRich V. -cART/Allergy : What to do about NKA only via right-click menu? Add here? }
411 if ItemIEN > 0 then
412 begin
413 if ARTPatchInstalled then
414 AllergyBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True, ItemIEN)
415 else
416 ReportBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True);
417 end;
418 TAG_POST:
419 if DisplayText[ItemIndex] = 'Allergies' then
420 ReportBox(DetailPosting('A'), DisplayText[ItemIndex], True)
421 else if ItemID <> '' then
422 begin
423 NotifyOtherApps(NAE_REPORT, 'TIU^' + ItemID);
424 ReportBox(DetailPosting(ItemID), DisplayText[ItemIndex], True);
425 end;
426 TAG_MEDS:
427 if (ItemID <> '') and (ItemID <> '0') then
428 ReportBox(DetailMed(ItemID), DisplayText[ItemIndex], True);
429 TAG_RMND:
430 if ItemIEN > 0 then
431 ReportBox(DetailReminder(ItemIEN), ClinMaintText + ': ' + DisplayText[ItemIndex], True);
432 TAG_LABS:
433 if (ItemID <> '') and (Piece(ItemID,';',1) <> '0') and (not ContainsAlpha(Piece(ItemID,';',1))) then
434 ReportBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True);
435 TAG_VITL:
436 if ItemID <> '' then
437 begin
438 SelectVitals(Font.Size);
439 StatusText('Searching for recent vitals...');
440 with frmCover do
441 for i := ComponentCount - 1 downto 0 do
442 begin
443 if Components[i] is TORListBox then
444 begin
445 case Components[i].Tag of
446 70: ListVitals((Components[i] as TORListBox).Items);
447 end;
448 end;
449 end;
450 StatusText('');
451 end;
452
453 TAG_VSIT:
454 if (ItemID <> '') and (ItemID <> '0') then
455 ReportBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True);
456 else
457 //don't try to display a detail report
458 end;
459 ItemIndex := -1;
460 end;
461end;
462
463procedure TfrmCover.FormClose(Sender: TObject; var Action: TCloseAction);
464begin
465 inherited;
466 timPoll.Enabled := False;
467 if Length(FLoadingForDFN) > 0 then StopCoverSheet(FLoadingForDFN, uIPAddress, frmFrame.Handle); //*DFN*
468 FLoadingForDFN := ''; //*DFN*
469end;
470
471procedure TfrmCover.timPollTimer(Sender: TObject);
472const
473 RemUnchanged = '[{^Reminders @ @ @ Unchanged^]}';
474
475var
476 Done: Boolean;
477 ReminderSL: TStringList;
478 ProbSL, PostSL, MedsSL, RemSL, LabsSL, VitSL, VisitSL: TStringList;
479 i, iProb, iPost, iMeds, iRem, iLabs, iVit, iVisit: integer;
480begin
481 inherited;
482 iProb := -1;
483 iPost := -1;
484 iMeds := -1;
485 iRem := -1;
486 iLabs := -1;
487 iVit := -1;
488 iVisit := -1;
489 with frmCover do
490 for i := ComponentCount - 1 downto 0 do
491 begin
492 if Components[i] is TORListBox then
493 begin
494 case Components[i].Tag of
495 TAG_PROB: iProb := i;
496 TAG_POST: iPost := i;
497 TAG_MEDS: iMeds := i;
498 TAG_RMND: iRem := i;
499 TAG_LABS: iLabs := i;
500 TAG_VITL: iVit := i;
501 TAG_VSIT: iVisit := i;
502 end;
503 end;
504 end;
505 ProbSL := TStringList.Create;
506 PostSL := TStringList.Create;
507 MedsSL := TStringList.Create;
508 RemSL := TStringList.Create;
509 LabsSL := TStringList.Create;
510 VitSL := TStringList.Create;
511 VisitSL := TStringList.Create;
512 if InteractiveRemindersActive then
513 begin
514 ReminderSL := TStringList.Create;
515 try
516 ReminderSL.Add(RemUnchanged);
517 ListAllBackGround(Done, ProbSL, PostSL, MedsSL, ReminderSL, LabsSL, VitSL, VisitSL, uIPAddress, frmFrame.Handle);
518 if (iProb > -1) and (ProbSL.Count > 0) then (Components[iProb] as TORListBox).Items.Assign(ProbSL);
519 if (iPost > -1) and (PostSL.Count > 0) then (Components[iPost] as TORListBox).Items.Assign(PostSL);
520 if (iMeds > -1) and (MedsSL.Count > 0) then (Components[iMeds] as TORListBox).Items.Assign(MedsSL);
521 if (iLabs > -1) and (LabsSL.Count > 0) then (Components[iLabs] as TORListBox).Items.Assign(LabsSL);
522 if (iVit > -1) and (VitSL.Count > 0) then (Components[iVit] as TORListBox).Items.Assign(VitSL);
523 if (iVisit > -1) and (VisitSL.Count > 0) then (Components[iVisit] as TORListBox).Items.Assign(VisitSL);
524 // since this RPC is connected to a timer, clear the results each time to make sure that
525 // the results aren't passed to another RPC in the case that there is an error
526 RPCBrokerV.ClearResults := True;
527 if Done then
528 begin
529 timPoll.Enabled := False;
530 FLoadingForDFN := ''; //*DFN*
531 end;
532 if(not InitialRemindersLoaded) and
533 (ReminderSL.Count <> 1) or (ReminderSL[0] <> RemUnchanged) then
534 begin
535 CoverSheetRemindersInBackground := FALSE;
536// InitialRemindersLoaded := TRUE;
537 RemindersEvaluated(ReminderSL);
538 NotifyWhenRemindersChange(RemindersChange);
539 end;
540 finally
541 ReminderSL.Free;
542 end;
543 end
544 else
545 begin
546 ListAllBackGround(Done, ProbSL, PostSL, MedsSL, RemSL, LabsSL, VitSL, VisitSL, uIPAddress, frmFrame.Handle);
547 if (iProb > -1) and (ProbSL.Count > 0) then (Components[iProb] as TORListBox).Items.Assign(ProbSL);
548 if (iPost > -1) and (PostSL.Count > 0) then (Components[iPost] as TORListBox).Items.Assign(PostSL);
549 if (iMeds > -1) and (MedsSL.Count > 0) then (Components[iMeds] as TORListBox).Items.Assign(MedsSL);
550 if (iRem > -1) and (RemSL.Count > 0) then (Components[iRem] as TORListBox).Items.Assign(RemSL);
551 if (iLabs > -1) and (LabsSL.Count > 0) then (Components[iLabs] as TORListBox).Items.Assign(LabsSL);
552 if (iVit > -1) and (VitSL.Count > 0) then (Components[iVit] as TORListBox).Items.Assign(VitSL);
553 if (iVisit > -1) and (VisitSL.Count > 0) then (Components[iVisit] as TORListBox).Items.Assign(VisitSL);
554 // since this RPC is connected to a timer, clear the results each time to make sure that
555 // the results aren't passed to another RPC in the case that there is an error
556 RPCBrokerV.ClearResults := True;
557 if Done then
558 begin
559 timPoll.Enabled := False;
560 FLoadingForDFN := ''; //*DFN*
561 end;
562 end;
563 ProbSL.Free;
564 PostSL.Free;
565 MedsSL.Free;
566 RemSL.Free;
567 LabsSL.Free;
568 VitSL.Free;
569 VisitSL.Free;
570end;
571
572procedure TfrmCover.NotifyOrder(OrderAction: Integer; AnOrder: TOrder); {REV}
573var
574 i: integer;
575begin
576 case OrderAction of
577 ORDER_SIGN:
578 begin
579 with frmCover do
580 for i := ComponentCount - 1 downto 0 do
581 begin
582 if Components[i] is TORListBox then
583 begin
584 case Components[i].Tag of
585 20: UpdateAllergiesList;
586 30: ListPostings((Components[i] as TORListBox).Items);
587 end;
588 end;
589 end;
590 end;
591 end;
592end;
593
594procedure TfrmCover.RemindersChange(Sender: TObject);
595var
596 i: integer;
597 tmp: string;
598 lb: TORListBox;
599
600begin
601 lb := nil;
602 with frmCover do
603 for i := ComponentCount - 1 downto 0 do
604 begin
605 if (Components[i] is TORListBox) and (Components[i].Tag = TAG_RMND) then
606 begin
607 lb := (Components[i] as TORListBox);
608 break;
609 end;
610 end;
611 if assigned(lb) then
612 begin
613 lb.Clear;
614 i := -1;
615 repeat
616 i := ActiveReminders.IndexOfPiece('1',U,6,i);
617 if(i >= 0) then
618 begin
619 tmp := ActiveReminders[i];
620 SetPiece(tmp, U, 3, FormatFMDateTimeStr('mmm dd,yy', Piece(tmp, U, 3)));
621 lb.Items.Add(tmp);
622 end;
623 until(i < 0);
624 if(RemindersEvaluatingInBackground) then
625 lb.Items.Insert(0,'0^Evaluating Reminders...')
626 else
627 if(lb.Items.Count = 0) and (RemindersStarted) then
628 lb.Items.Add(NoDataText(TRUE));
629 end;
630end;
631
632Procedure TfrmCover.RemContextPopup(Sender: TObject;
633 MousePos: TPoint; var Handled: Boolean);
634var
635 idx: integer;
636 i, iRem: integer;
637begin
638 inherited;
639 Handled := TRUE;
640 iRem := -1;
641 with frmCover do
642 for i := ComponentCount - 1 downto 0 do
643 begin
644 if Components[i] is TORListBox then
645 begin
646 case Components[i].Tag of
647 TAG_RMND: iRem := i;
648 end;
649 end;
650 end;
651 if iRem > -1 then
652 if ((frmCover.Components[iRem] as TORListBox).ItemIndex >= 0) then
653 begin
654 idx := StrToIntDef(Piece((frmCover.Components[iRem] as TORListBox).Items[(frmCover.Components[iRem] as TORListBox).ItemIndex],U,1),0);
655 if(idx <> 0) then
656 begin
657 popReminders.Data := RemCode + (frmCover.Components[iRem] as TORListBox).Items[(frmCover.Components[iRem] as TORListBox).ItemIndex];
658 Handled := FALSE;
659 end;
660 end;
661end;
662
663procedure TfrmCover.FormCreate(Sender: TObject);
664begin
665 inherited;
666 PageID := CT_COVER;
667 FCoverList := TCoverSheetList.Create;
668 FCoverList.Add(pnl_1, lbl_1, lst_1);
669 FCoverList.Add(pnl_2, lbl_2, lst_2);
670 FCoverList.Add(pnl_3, lbl_3, lst_3);
671 FCoverList.Add(pnl_4, lbl_4, lst_4);
672 FCoverList.Add(pnl_5, lbl_5, lst_5);
673 FCoverList.Add(pnl_6, lbl_6, lst_6);
674 FCoverList.Add(pnl_7, lbl_7, lst_7);
675 FCoverList.Add(pnl_8, lbl_8, lst_8);
676 if ColorToRGB(clWindowText) <> ColorToRGB(clBlack) then
677 lst_3.Font.Color := clWindowText;
678end;
679
680procedure TfrmCover.FormDestroy(Sender: TObject);
681begin
682 inherited;
683 FCoverList.Free;
684end;
685
686procedure TfrmCover.sptBottomCanResize(Sender: TObject;
687 var NewSize: Integer; var Accept: Boolean);
688begin
689 inherited;
690 if NewSize < 50 then
691 Newsize := 50;
692end;
693
694procedure TfrmCover.sptTopCanResize(Sender: TObject; var NewSize: Integer;
695 var Accept: Boolean);
696begin
697 inherited;
698 if NewSize < 50 then
699 Newsize := 50;
700end;
701
702procedure TfrmCover.spt_1CanResize(Sender: TObject; var NewSize: Integer;
703 var Accept: Boolean);
704begin
705 inherited;
706 if NewSize < 50 then
707 Newsize := 50;
708end;
709
710procedure TfrmCover.spt_2CanResize(Sender: TObject; var NewSize: Integer;
711 var Accept: Boolean);
712begin
713 inherited;
714 if NewSize < 50 then
715 Newsize := 50;
716end;
717
718procedure TfrmCover.spt_3CanResize(Sender: TObject; var NewSize: Integer;
719 var Accept: Boolean);
720begin
721 inherited;
722 if NewSize < 50 then
723 Newsize := 50;
724end;
725
726procedure TfrmCover.spt_4CanResize(Sender: TObject; var NewSize: Integer;
727 var Accept: Boolean);
728begin
729 inherited;
730 if NewSize < 50 then
731 Newsize := 50;
732end;
733
734procedure TfrmCover.spt_5CanResize(Sender: TObject; var NewSize: Integer;
735 var Accept: Boolean);
736begin
737 inherited;
738 if NewSize < 50 then
739 Newsize := 50;
740end;
741
742procedure TfrmCover.popMenuAllergiesPopup(Sender: TObject);
743const
744 NO_ASSESSMENT = 'No Allergy Assessment';
745var
746 AListBox: TORListBox;
747begin
748 inherited;
749 AListBox := (popMenuAllergies.PopupComponent as TORListBox);
750 popEditAllergy.Enabled := AListBox.ItemIEN > 0;
751 popEnteredInError.Enabled := AListBox.ItemIEN > 0;
752 popNKA.Enabled := (AListBox.Items.Count = 1) and
753 (Piece(AListBox.Items[0], U, 2) = NO_ASSESSMENT);
754end;
755
756procedure TfrmCover.popNewAllergyClick(Sender: TObject);
757const
758 NEW_ALLERGY = True;
759 ENTERED_IN_ERROR = True;
760var
761 Changed: boolean;
762begin
763 inherited;
764 Changed := EnterEditAllergy(0, NEW_ALLERGY, not ENTERED_IN_ERROR);
765 if Changed then UpdateAllergiesList;
766end;
767
768procedure TfrmCover.popNKAClick(Sender: TObject);
769var
770 Changed: boolean;
771begin
772 inherited;
773 Changed := EnterNKAForPatient;
774 if Changed then UpdateAllergiesList;
775end;
776
777procedure TfrmCover.popEditAllergyClick(Sender: TObject);
778const
779 NEW_ALLERGY = True;
780 ENTERED_IN_ERROR = True;
781begin
782 inherited;
783 EnterEditAllergy((popMenuAllergies.PopupComponent as TORListBox).ItemIEN, not NEW_ALLERGY, not ENTERED_IN_ERROR);
784end;
785
786procedure TfrmCover.popEnteredInErrorClick(Sender: TObject);
787var
788 Changed: boolean;
789begin
790 inherited;
791 Changed := MarkEnteredInError((popMenuAllergies.PopupComponent as TORListBox).ItemIEN);
792 if Changed then UpdateAllergiesList;
793end;
794
795procedure TfrmCover.UpdateAllergiesList;
796var
797 bCase, bInvert: boolean;
798 iDatePiece: integer ;
799 x, aRPC, aDateFormat, aParam1, aID, aDetail, aStatus, aName, aCase, aInvert, aDatePiece, aTextColor, aQualifier, aTabPos, aPiece, aIFN: string;
800begin
801 x := uARTCoverSheetParams;
802 if x = '' then exit;
803 aName := Piece(x,'^',2);
804 aRPC := Piece(x,'^',6);
805 aCase := Piece(x,'^',7);
806 aInvert := Piece(x,'^',8);
807 aDatePiece := Piece(x,'^',11);
808 aDateFormat := Piece(x,'^',10);
809 aTextColor := Piece(x,'^',9);
810 aStatus := 'Searching for ' + Piece(x,'^',2) + '...';
811 aParam1 := Piece(x,'^',12);
812 aID := Piece(x,'^',1); //TAG_PROB, TAG_RMND, ETC.
813 aQualifier := Piece(x,'^',13);
814 aTabPos := Piece(x,'^',14);
815 aPiece := Piece(x,'^',15);
816 aDetail := Piece(x,'^',16);
817 aIFN := Piece(x,'^',17);
818 bCase := FALSE;
819 bInvert := FALSE;
820 iDatePiece := 0;
821 if aCase = '1' then bCase := TRUE;
822 if aInvert = '1' then bInvert := TRUE;
823 if Length(aDatePiece) > 0 then iDatePiece := StrToInt(aDatePiece);
824 if Length(aTextColor) > 0 then aTextColor := 'cl' + aTextColor;
825 // Assign properties to components
826 if Length(aTabPos) > 0 then (popMenuAllergies.PopupComponent as TORListBox).TabPositions := aTabPos;
827 if Length(aTextColor) > 0 then (popMenuAllergies.PopupComponent as TORListBox).Font.Color := StringToColor(aTextColor);
828 if Length(aPiece) > 0 then (popMenuAllergies.PopupComponent as TORListBox).Pieces := aPiece;
829 (popMenuAllergies.PopupComponent as TORListBox).Tag := StrToInt(aID);
830 LoadList(aStatus, (popMenuAllergies.PopupComponent as TORListBox), aRpc, bCase, bInvert, iDatePiece, aDateFormat, aParam1, aID, aDetail);
831 with frmFrame do
832 begin
833 lblPtCWAD.Caption := GetCWADInfo(Patient.DFN);
834 if Length(lblPtCWAD.Caption) > 0
835 then lblPtPostings.Caption := 'Postings'
836 else lblPtPostings.Caption := 'No Postings';
837 pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
838 end;
839end;
840
841procedure TfrmCover.CoverItemExit(Sender: TObject);
842begin
843 with Sender as TORListBox do
844 Selected[ItemIndex] := False;
845 inherited;
846end;
847
848procedure TfrmCover.GetPatientFlag;
849begin
850 pnlFlag.Visible := HasFlag;
851 sptFlag.Visible := HasFlag;
852 lstFlag.Items.Assign(FlagList);
853end;
854
855procedure TfrmCover.lstFlagClick(Sender: TObject);
856begin
857 if lstFlag.ItemIndex >= 0 then
858 ShowFlags(lstFlag.ItemID);
859end;
860
861procedure TfrmCover.lstFlagKeyDown(Sender: TObject; var Key: Word;
862 Shift: TShiftState);
863begin
864 inherited;
865 if Key = VK_RETURN then
866 lstFlagClick(Self);
867end;
868
869end.
870
Note: See TracBrowser for help on using the repository browser.