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

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

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