source: cprs/trunk/CPRS-Chart/fCover.pas@ 1722

Last change on this file since 1722 was 1679, checked in by healthsevak, 10 years ago

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