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

Last change on this file since 924 was 830, checked in by Kevin Toppenberg, 14 years ago

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