source: cprs/branches/tmg-cprs/CPRS-Chart/fCover.pas@ 1156

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

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