source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fEncounterFrame.pas@ 800

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

Fixed missing TDKLang. Class, Added email demographic, Fixed field error in demographis

File size: 29.9 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fEncounterFrame;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 Tabs, ComCtrls, ExtCtrls, Menus, StdCtrls, Buttons, fPCEBase,
9 fVisitType, fDiagnoses, fProcedure, fImmunization, fSkinTest, fPatientEd,
10 fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals,rvitals,
11 DKLang;
12
13const
14 //tab names
15//CT_VisitNm = 'Visit Type'; //kt 8/8/2007
16//CT_DiagNm = 'Diagnoses'; //kt 8/8/2007
17//CT_ProcNm = 'Procedures'; //kt 8/8/2007
18//CT_ImmNm = 'Immunizations'; //kt 8/8/2007
19//CT_SkinNm = 'Skin Tests'; //kt 8/8/2007
20//CT_PedNm = 'Patient Ed'; //kt 8/8/2007
21//CT_HlthNm = 'Health Factors'; //kt 8/8/2007
22//CT_XamNm = 'Exams'; //kt 8/8/2007
23//CT_VitNm = 'Vitals'; //kt 8/8/2007
24 CT_GAFNm = 'GAF';
25
26Function CT_VisitNm : string;
27Function CT_DiagNm : string;
28Function CT_ProcNm : string;
29Function CT_ImmNm : string;
30Function CT_SkinNm : string;
31Function CT_PedNm : string;
32Function CT_HlthNm : string;
33Function CT_XamNm : string;
34Function CT_VitNm : string;
35
36Const
37 //numbers assigned to tabs to make changes easier
38 //they must be sequential
39 CT_NOPAGE = -1;
40 CT_UNKNOWN = 0;
41 CT_VISITTYPE = 1; CT_FIRST = 1;
42 CT_DIAGNOSES = 2;
43 CT_PROCEDURES = 3;
44 CT_IMMUNIZATIONS = 4;
45 CT_SKINTESTS = 5;
46 CT_PATIENTED = 6;
47 CT_HEALTHFACTORS = 7;
48 CT_EXAMS = 8;
49 CT_VITALS = 9;
50 CT_GAF = 10; CT_LAST = 10;
51
52 NUM_TABS = 3;
53 TAG_VTYPE = 10;
54 TAG_DIAG = 20;
55 TAG_PROC = 30;
56 TAG_IMMUNIZ = 40;
57 TAG_SKIN = 50;
58 TAG_PED = 60;
59 TAG_HF = 70;
60 TAG_XAM = 80;
61 TAG_TRT = 90;
62
63Function TX_NOSECTION : string; //kt
64Function TX_PROV_REQ : string; //kt
65Function TC_PROV_REQ : string; //kt
66
67//TX_NOSECTION = '-1^No sections found'; <-- original line. //kt 8/8/2007
68//TX_PROV_REQ = 'A primary encounter provider must be selected before encounter data can' + CRLF + <-- original line. //kt 8/8/2007
69// 'be saved. Select the Primary Encounter Provider on the VISIT TYPE tab.' + CRLF + <-- original line. //kt 8/8/2007
70// 'Otherwise, press <Cancel> to quit without saving data.'; <-- original line. //kt 8/8/2007
71
72//TC_PROV_REQ = 'Missing Primary Provider for Encounter'; <-- original line. //kt 8/8/2007
73
74type
75 TfrmEncounterFrame = class(TForm)
76 StatusBar1: TStatusBar;
77 pnlPage: TPanel;
78 Bevel1: TBevel;
79 TabControl: TTabControl;
80
81 procedure tabPageChange(Sender: TObject; NewTab: Integer;
82 var AllowChange: Boolean);
83 procedure FormResize(Sender: TObject);
84 procedure SectionClick(Sender: TObject);
85 procedure FormDestroy(Sender: TObject);
86 procedure FormCreate(Sender: TObject);
87 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
88 procedure TabControlChange(Sender: TObject);
89 procedure TabControlChanging(Sender: TObject;
90 var AllowChange: Boolean);
91 procedure TabControlExit(Sender: TObject);
92 procedure FormKeyDown(Sender: TObject; var Key: Word;
93 Shift: TShiftState);
94 procedure FormClose(Sender: TObject; var Action: TCloseAction);
95 procedure FormCanResize(Sender: TObject; var NewWidth,
96 NewHeight: Integer; var Resize: Boolean);
97
98 private
99 //kt Begin Mod (change Consts to Vars) 8/8/2007
100 TXT_SAVECHANGES : string; //kt
101 //kt End Mod -------------------
102 FAutoSave: boolean;
103 FSaveNeeded: boolean;
104 FChangeSource: Integer;
105 FCancel: Boolean; //Indicates the cancel button has been pressed;
106 FAbort: boolean; // indicates that neither OK or Cancel has been pressed
107 FormList: TStringList; //Holds the types of any forms that will be used
108 //in the frame. They must be available at compile time
109 FLastPage: TfrmPCEBase;
110 procedure CreateChildForms(Sender: TObject; Location: integer);
111 procedure SynchPCEData;
112 procedure SwitchToPage(NewForm: TfrmPCEBase); //was tfrmPage
113 function PageIDToForm(PageID: Integer): TfrmPCEBase;
114 function PageIDToTab(PageID: Integer): string;
115 procedure LoadFormList(Location: integer);
116 procedure CreateForms;
117 procedure AddTabs;
118 function FormListContains(item: string): Boolean;
119 procedure SendData;
120 procedure UpdateEncounter(PCE: TPCEData);
121 procedure SetFormFonts;
122 procedure SetupVars; //kt
123 public
124 procedure SelectTab(NewTabName: string);
125 property ChangeSource: Integer read FChangeSource;
126 property Forms: tstringlist read FormList;
127 property Cancel: Boolean read FCancel write FCancel;
128 property Abort: Boolean read FAbort write FAbort;
129 end;
130
131var
132 frmEncounterFrame: TfrmEncounterFrame;
133 uSCCond: TSCConditions;
134 uVisitType: TPCEProc; // contains info for visit type page
135 uEncPCEData: TPCEData;
136 uProviders: TPCEProviderList;
137
138// Returns true if PCE data still needs to be saved - vitals/gaf are always saved
139function UpdatePCE(PCEData: TPCEData; SaveOnExit: boolean = TRUE): boolean;
140
141implementation
142
143uses
144 uCore,
145 fGAF, uConst,
146 rCore, fPCEProvider, rMisc;
147
148{$R *.DFM}
149
150procedure TfrmEncounterFrame.SetupVars;
151//kt Added entire function to replace constant declarations 8/8/2007
152begin
153 SetupVars; //kt added 8/8/2007 to replace constants with vars.
154 TXT_SAVECHANGES := DKLangConstW('fEncounterFrame_Save_Changesx');
155end;
156
157Function CT_VisitNm : string;
158begin Result := DKLangConstW('fEncounterFrame_Visit_Type'); //kt added 8/8/2007
159end;
160
161Function CT_DiagNm : string;
162begin Result := DKLangConstW('fEncounterFrame_Diagnoses'); //kt added 8/8/2007
163end;
164
165Function CT_ProcNm : string;
166begin Result := DKLangConstW('fEncounterFrame_Procedures'); //kt added 8/8/2007
167end;
168
169Function CT_ImmNm : string;
170begin Result := DKLangConstW('fEncounterFrame_Immunizations'); //kt added 8/8/2007
171end;
172
173Function CT_SkinNm : string;
174begin Result := DKLangConstW('fEncounterFrame_Skin_Tests'); //kt added 8/8/2007
175end;
176
177Function CT_PedNm : string;
178begin Result := DKLangConstW('fEncounterFrame_Patient_Ed'); //kt added 8/8/2007
179end;
180
181Function CT_HlthNm : string;
182begin Result := DKLangConstW('fEncounterFrame_Health_Factors'); //kt added 8/8/2007
183end;
184
185Function CT_XamNm : string;
186begin Result := DKLangConstW('fEncounterFrame_Exams'); //kt added 8/8/2007
187end;
188
189Function CT_VitNm : string;
190begin Result := DKLangConstW('fEncounterFrame_Vitals'); //kt added 8/8/2007
191end;
192
193Function TX_NOSECTION : string;
194begin Result := '-1^'+DKLangConstW('fEncounterFrame_No_sections_found'); //kt added 8/8/2007
195end;
196
197Function TX_PROV_REQ : string;
198begin Result := DKLangConstW('fEncounterFrame_A_primary_encounter_provider_must_be_selected_before_encounter_data_can') + CRLF + //kt added 8/8/2007
199 DKLangConstW('fEncounterFrame_be_savedx__Select_the_Primary_Encounter_Provider_on_the_VISIT_TYPE_tabx') + CRLF + //kt added 8/8/2007
200 DKLangConstW('fEncounterFrame_Otherwisex_press_xCancelx_to_quit_without_saving_datax'); //kt added 8/8/2007
201end;
202
203Function TC_PROV_REQ : string;
204begin Result := DKLangConstW('fEncounterFrame_Missing_Primary_Provider_for_Encounter'); //kt added 8/8/2007
205end;
206
207
208{///////////////////////////////////////////////////////////////////////////////
209//Name: function TfrmEncounterFrame.PageIDToTab(PageID: Integer): String;
210//Created: Jan 1999
211//By: Robert Bott
212//Location: ISL
213//Description: returns the tab index that corresponds to a given PageID .
214///////////////////////////////////////////////////////////////////////////////}
215function TfrmEncounterFrame.PageIDToTab(PageID: Integer): String;
216begin
217 result := '';
218 case PageID of
219 CT_NOPAGE: Result := '';
220 CT_UNKNOWN: Result := '';
221 CT_VISITTYPE: Result := CT_VisitNm;
222 CT_DIAGNOSES: Result := CT_DiagNm;
223 CT_PROCEDURES: Result := CT_ProcNm;
224 CT_IMMUNIZATIONS: Result := CT_ImmNm;
225 CT_SKINTESTS: Result := CT_SkinNm;
226 CT_PATIENTED: Result := CT_PedNm;
227 CT_HEALTHFACTORS: Result := CT_HlthNm;
228 CT_EXAMS: Result := CT_XamNm;
229 CT_VITALS: Result := CT_VitNm;
230 CT_GAF: Result := CT_GAFNm;
231
232 end;
233end;
234
235
236{///////////////////////////////////////////////////////////////////////////////
237//Name: function TfrmEncounterFrame.PageIDToForm(PageID: Integer): TfrmPCEBase;
238//Created: Jan 1999
239//By: Robert Bott
240//Location: ISL
241//Description: return the form name based on the PageID}
242///////////////////////////////////////////////////////////////////////////////}
243function TfrmEncounterFrame.PageIDToForm(PageID: Integer): TfrmPCEBase;
244begin
245 case PageID of
246 CT_VISITTYPE: Result := frmVisitType;
247 CT_DIAGNOSES: Result := frmDiagnoses;
248 CT_PROCEDURES: Result := frmProcedures;
249 CT_IMMUNIZATIONS: Result := frmImmunizations;
250 CT_SKINTESTS: Result := frmSkinTests;
251 CT_PATIENTED: Result := frmPatientEd;
252 CT_HEALTHFACTORS: Result := frmHealthFactors;
253 CT_EXAMS: Result := frmExams;
254 CT_VITALS: Result := frmEncVitals;
255 CT_GAF: Result := frmGAF;
256 else //not a valid form
257 result := frmPCEBase;
258 end;
259end;
260
261
262{///////////////////////////////////////////////////////////////////////////////
263//Name: procedure TfrmEncounterFrame.CreatChildForms(Sender: TObject);
264//Created: Jan 1999
265//By: Robert Bott
266//Location: ISL
267//Description: Finds out what pages to display, has the pages and tabs created.
268///////////////////////////////////////////////////////////////////////////////}
269procedure TfrmEncounterFrame.CreateChildForms(Sender: TObject; Location: integer);
270begin
271 //load FormList with a list of all forms to display.
272 inherited;
273 LoadFormList(Location);
274 AddTabs;
275 CreateForms;
276end;
277
278
279
280{///////////////////////////////////////////////////////////////////////////////
281//Name: TfrmEncounterFrame.LoadFormList;
282//Created: Jan 1999
283//By: Robert Bott
284//Location: ISL
285//Description: Loads Formlist with the forms to create, will be replaced by RPC call.
286///////////////////////////////////////////////////////////////////////////////}
287procedure TfrmEncounterFrame.LoadFormList(Location: integer);
288begin
289 //change this to an RPC in RPCE.pas
290 FormList.clear;
291 FormList.add(CT_VisitNm);
292 FormList.add(CT_DiagNm);
293 FormList.add(CT_ProcNm);
294 formList.add(CT_VitNm);
295 formList.add(CT_ImmNm);
296 formList.add(CT_SkinNm);
297 formList.add(CT_PedNm);
298 formList.add(CT_HlthNm);
299 formList.add(CT_XamNm);
300 if MHClinic(Location) then
301 formList.add(CT_GAFNm);
302 end;
303
304
305{///////////////////////////////////////////////////////////////////////////////
306//Name: function TfrmEncounterFrame.FormListContains(item: string): Boolean;
307//Created: 12/06/98
308//By: Robert Bott
309//Location: ISL
310//Description: Returns a boolean value indicating if a given string exists in
311// the formlist.
312///////////////////////////////////////////////////////////////////////////////}
313function TfrmEncounterFrame.FormListContains(item: string): Boolean;
314begin
315 result := false;
316 if (FormList.IndexOf(item) <> -1 ) then
317 result := true;
318end;
319
320{///////////////////////////////////////////////////////////////////////////////
321//Name: procedure TfrmEncounterFrame.CreateForms;
322//Created: Jan 1999
323//By: Robert Bott
324//Location: ISL
325//Description: Creates all of the forms in the list.
326///////////////////////////////////////////////////////////////////////////////}
327procedure TfrmEncounterFrame.CreateForms;
328var
329 i: integer;
330begin
331 //could this be placed in a loop using PagedIdToTab & PageIDToFOrm & ?
332
333 if FormListContains(CT_VisitNm) then
334 frmVisitType := TfrmVisitType.CreateLinked(pnlPage);
335 if FormListContains(CT_DiagNm) then
336 frmDiagnoses := TfrmDiagnoses.CreateLinked(pnlPage);
337 if FormListContains(CT_ProcNm) then
338 frmProcedures := TfrmProcedures.CreateLinked(pnlPage);
339 if FormListContains(CT_VitNm) then
340 frmEncVitals := TfrmEncVitals.CreateLinked(pnlPage);
341 if FormListContains(CT_ImmNm) then
342 frmImmunizations := TfrmImmunizations.CreateLinked(pnlPage);
343 if FormListContains(CT_SkinNm) then
344 frmSkinTests := TfrmSkinTests.CreateLinked(pnlPage);
345 if FormListContains(CT_PedNm) then
346 frmPatientEd := TfrmPatientEd.CreateLinked(pnlPage);
347 if FormListContains(CT_HlthNm) then
348 frmHealthFactors := TfrmHEalthFactors.CreateLinked(pnlPage);
349 if FormListContains(CT_XamNm) then
350 frmExams := TfrmExams.CreateLinked(pnlPage);
351 if FormListContains(CT_GAFNm) then
352 frmGAF := TfrmGAF.CreateLinked(pnlPage);
353 //must switch based on caption, as all tabs may not be present.
354 for i := CT_FIRST to CT_LAST do
355 begin
356 if Formlist.IndexOf(PageIdToTab(i)) <> -1 then
357 PageIDToForm(i).Visible := (Formlist.IndexOf(PageIdToTab(i)) = 0);
358 end;
359end;
360
361
362{///////////////////////////////////////////////////////////////////////////////
363//Name: TfrmEncounterFrame.SwitchToPage(NewForm: tfrmPCEBase);
364//Created: Jan 1999
365//By: Robert Bott
366//Location: ISL
367//Description: Brings the selected page to the front for display.
368///////////////////////////////////////////////////////////////////////////////}
369procedure TfrmEncounterFrame.SwitchToPage(NewForm: tfrmPCEBase);// was TfrmPage);
370{ unmerge/merge menus, bring page to top of z-order, call form-specific OnDisplay code }
371begin
372 if (NewForm = nil) or (FLastPage = NewForm) then Exit;
373 if Assigned(FLastPage) then
374 FLastPage.Hide;
375 FLastPage := NewForm;
376// KeyPreview := (NewForm = frmEncVitals);
377 NewForm.DisplayPage; // this calls BringToFront for the form
378end;
379
380
381
382{///////////////////////////////////////////////////////////////////////////////
383//Name: procedure TfrmEncounterFrame.tabPageChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
384//Created: Jan 1999
385//By: Robert Bott
386//Location: ISL
387//Description: Finds the page, and calls SwithToPage to display it.
388///////////////////////////////////////////////////////////////////////////////}
389procedure TfrmEncounterFrame.tabPageChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
390{ switches to form linked to NewTab }
391var
392 i: integer;
393begin
394//must switch based on caption, as all tabs may not be present.
395for i := CT_FIRST to CT_LAST do
396 begin
397 With Formlist do
398 if NewTab = IndexOf(PageIdToTab(i)) then
399 begin
400 PageIDToForm(i).show;
401 SwitchToPage(PageIDToForm(i));
402 end;
403 end;
404end;
405
406{ Resize and Font-Change procedures --------------------------------------------------------- }
407
408{///////////////////////////////////////////////////////////////////////////////
409//Name: procedure TfrmEncounterFrame.FormResize(Sender: TObject);
410//Created: Jan 1999
411//By: Robert Bott
412//Location: ISL
413//Description: Resizes all windows when parent changes.
414///////////////////////////////////////////////////////////////////////////////}
415procedure TfrmEncounterFrame.FormResize(Sender: TObject);
416var
417 i: integer;
418begin
419 for i := CT_FIRST to CT_LAST do
420 if (FormList.IndexOf(PageIdToTab(i)) <> -1) then
421 MoveWindow(PageIdToForm(i).Handle, 0, 0, pnlPage.ClientWidth, pnlpage.ClientHeight, true);
422 self.repaint;
423end;
424
425{///////////////////////////////////////////////////////////////////////////////
426//Name: procedure TfrmEncounterFrame.AddTabs;
427//Created: Jan 1999
428//By: Robert Bott
429//Location: ISL
430//Description: adds a tab for each page that will be displayed
431///////////////////////////////////////////////////////////////////////////////}
432procedure TfrmEncounterFrame.AddTabs;
433
434var
435 i: integer;
436begin
437 TabControl.Tabs.Clear;
438 for I := 0 to (Formlist.count - 1) do
439 TabControl.Tabs.Add(Formlist.Strings[i]);
440end;
441
442
443{///////////////////////////////////////////////////////////////////////////////
444//Name: procedure UpdatePCE(PCEData: TPCEData);
445//Created: Jan 1999
446//By: Robert Bott
447//Location: ISL
448//Description: The main call to open the encounter frame and capture encounter
449// information.
450///////////////////////////////////////////////////////////////////////////////}
451function UpdatePCE(PCEData: TPCEData; SaveOnExit: boolean = TRUE): boolean;
452var
453// FontHeight,
454// FontWidth: Integer;
455 AUser: string;
456
457begin
458 frmEncounterFrame := TfrmEncounterFrame.Create(Application);
459 try
460 frmEncounterFrame.FAutoSave := SaveOnExit;
461
462 uEncPCEData := PCEData;
463 if(uEncPCEData.Empty and ((uEncPCEData.Location = 0) or (uEncPCEData.VisitDateTime = 0)) and
464 (not Encounter.NeedVisit)) then
465 uEncPCEData.UseEncounter := TRUE;
466// frmEncounterFrame.Caption := 'Encounter Form for ' + ExternalName(uEncPCEData.Location, 44) + <-- original line. //kt 8/8/2007
467 frmEncounterFrame.Caption := DKLangConstW('fEncounterFrame_Encounter_Form_for') + ExternalName(uEncPCEData.Location, 44) + //kt added 8/8/2007
468 ' (' + FormatFMDateTime('mmm dd,yyyy@hh:nn', uEncPCEData.VisitDateTime) + ')';
469
470 uProviders.Assign(uEncPCEData.Providers);
471 SetDefaultProvider(uProviders, uEncPCEData);
472 AUser := IntToStr(uProviders.PendingIEN(FALSE));
473 if(AUser <> '0') and (uProviders.IndexOfProvider(AUser) < 0) and
474 AutoCheckout(uEncPCEData.Location) then
475 uProviders.AddProvider(AUser, uProviders.PendingName(FALSE), FALSE);
476
477 frmEncounterFrame.CreateChildForms(frmEncounterFrame, PCEData.Location);
478 ResizeAnchoredFormToFont(frmEncounterFrame);
479 SetFormPosition(frmEncounterFrame);
480
481 with frmEncounterFrame do
482 begin
483 SetRPCEncLocation(PCEData.Location);
484 SynchPCEData;
485 TabControl.Tabindex := 0;
486 TabControlChange(TabControl);
487
488 ShowModal;
489 Result := FSaveNeeded;
490 end;
491 finally
492 // frmEncounterFrame.Free; v22.11 (JD and SM)
493 frmEncounterFrame.Release;
494 //frmEncounterFrame := nil; access violation source? removed 7/28/03 RV
495 end;
496end;
497
498{///////////////////////////////////////////////////////////////////////////////
499//Name: TfrmEncounterFrame.SectionClick(Sender: TObject);
500//Created: Jan 1999
501//By: Robert Bott
502//Location: ISL
503//Description: Call the procedure apropriate for the selected tab
504///////////////////////////////////////////////////////////////////////////////}
505procedure TfrmEncounterFrame.SectionClick(Sender: TObject);
506begin
507 with Sender as TListBox do case Tag of
508 TAG_VTYPE: if FormListContains(CT_VisitNm) then
509 begin
510 with frmVisitType do
511 lstVTypeSectionClick(Sender);
512 end;
513 end;
514end;
515
516{///////////////////////////////////////////////////////////////////////////////
517//Name: procedure TfrmEncounterFrame.SynchPCEData;
518//Created: Jan 1999
519//By: Robert Bott
520//Location: ISL
521//Description: Synchronize any existing PCE data with what is displayed in the form.
522///////////////////////////////////////////////////////////////////////////////}
523procedure TfrmEncounterFrame.SynchPCEData;
524
525 procedure InitList(AListBox: TORListBox);
526 var
527 DoClick: boolean;
528
529 begin
530 with AListBox do
531 begin
532 DoClick := TRUE;
533 case Tag of
534 TAG_VTYPE: begin
535 if FormListContains(CT_VisitNm) then
536 ListVisitTypeSections(Items);
537 DoClick := AutoSelectVisit(PCERPCEncLocation);
538 end;
539 end;
540 if Items.Count > 0 then
541 begin
542 if DoClick then
543 begin
544 ItemIndex := 0;
545 SectionClick(AListBox);
546 end;
547 end
548 else Items.Add(TX_NOSECTION);
549 end;
550 end;
551
552begin
553 if FormListContains(CT_VisitNm) then
554 with frmVisitType do
555 begin
556 InitList(frmVisitType.lstVTypeSection); // set up Visit Type page
557 ListSCDisabilities(memSCDisplay.Lines);
558 uSCCond := EligbleConditions;
559 frmVisitType.fraVisitRelated.InitAllow(uSCCond);
560 end;
561 with uEncPCEData do // load any existing data from PCEData
562 begin
563 if FormListContains(CT_VisitNm) then
564 frmVisitType.fraVisitRelated.InitRelated(uEncPCEData);
565 if FormListContains(CT_DiagNm) then
566 frmDiagnoses.InitTab(CopyDiagnoses, ListDiagnosisSections);
567 if FormListContains(CT_ProcNm) then
568 frmProcedures.InitTab(CopyProcedures, ListProcedureSections);
569 if FormListContains(CT_ImmNm) then
570 frmImmunizations.InitTab(CopyImmunizations,ListImmunizSections);
571 if FormListContains(CT_SkinNm) then
572 frmSkinTests.InitTab(CopySkinTests, ListSkinSections);
573 if FormListContains(CT_PedNm) then
574 frmPatientEd.InitTab(CopyPatientEds, ListPatientSections);
575 if FormListContains(CT_HlthNm) then
576 frmHealthFactors.InitTab(CopyHealthFactors, ListHealthSections);
577 if FormListContains(CT_XamNm) then
578 frmExams.InitTab(CopyExams, ListExamsSections);
579 uVisitType.Assign(VisitType);
580 if FormListContains(CT_VisitNm) then
581 with frmVisitType do
582 begin
583 MatchVType;
584 end;
585 end;
586end;
587
588
589{///////////////////////////////////////////////////////////////////////////////
590//Name: procedure TfrmEncounterFrame.FormDestroy(Sender: TObject);
591//Created: Jan 1999
592//By: Robert Bott
593//Location: ISL
594//Description: Free up objects in memory when destroying form.
595///////////////////////////////////////////////////////////////////////////////}
596procedure TfrmEncounterFrame.FormDestroy(Sender: TObject);
597var
598 i: integer;
599
600begin
601 inherited;
602 for i := ComponentCount-1 downto 0 do
603 if(Components[i] is TForm) then
604 TForm(Components[i]).Free;
605
606 formlist.clear;
607 KillObj(@uProviders);
608 uVisitType.Free;
609 Formlist.free;
610end;
611
612
613{///////////////////////////////////////////////////////////////////////////////
614//Name: procedure TfrmEncounterFrame.FormCreate(Sender: TObject);
615//Created: Jan 1999
616//By: Robert Bott
617//Location: ISL
618//Description: Create instances of the objects needed.
619///////////////////////////////////////////////////////////////////////////////}
620procedure TfrmEncounterFrame.FormCreate(Sender: TObject);
621begin
622 uProviders := TPCEProviderList.Create;
623 uVisitType := TPCEProc.create;
624 //uVitalOld := TStringList.create;
625 //uVitalNew := TStringList.create;
626 FormList := TStringList.create;
627 fCancel := False;
628 FAbort := TRUE;
629 SetFormFonts;
630end;
631
632
633{///////////////////////////////////////////////////////////////////////////////
634//Name: procedure TfrmEncounterFrame.SendData;
635//Created: Jan 1999
636//By: Robert Bott
637//Location: ISL
638//Description: Send Data back to the M side sor storing.
639///////////////////////////////////////////////////////////////////////////////}
640procedure TfrmEncounterFrame.SendData;
641//send PCE data to the RPC
642var
643 StoreMessage: string;
644 GAFScore: integer;
645 GAFDate: TFMDateTime;
646 GAFStaff: Int64;
647
648begin
649 inherited;
650 // do validation for vitals & anything else here
651
652 //process vitals
653 if FormListContains(CT_VitNm) then
654 begin
655 with frmEncVitals do
656 if HasData then
657 begin
658 if AssignVitals then
659 begin
660 StoreMessage := ValAndStoreVitals(frmEncVitals.VitalNew);
661// if (Storemessage <> 'True') then <-- original line. //kt 8/8/2007
662 if (Storemessage <> DKLangConstW('fEncounterFrame_True')) then //kt added 8/8/2007
663 begin
664 showmessage(storemessage);
665// exit;
666 end;
667 end;
668 end;
669 end;
670
671 if(FormListContains(CT_GAFNm)) then
672 begin
673 frmGAF.GetGAFScore(GAFScore, GAFDate, GAFStaff);
674 if(GAFScore > 0) then
675 SaveGAFScore(GAFScore, GAFDate, GAFStaff);
676 end;
677
678 //PCE
679
680 UpdateEncounter(uEncPCEData);
681 with uEncPCEData do
682 begin
683 if FAutoSave then
684 Save
685 else
686 FSaveNeeded := TRUE;
687 end;
688 Close;
689end;
690
691{///////////////////////////////////////////////////////////////////////////////
692//Name: procedure TfrmEncounterFrame.FormCloseQuery(Sender: TObject;
693//Created: Jan 1999
694//By: Robert Bott
695//Location: ISL
696//Description: Check to see if the Cancel button was pressed, if not, call
697// procedure to send the data to the server.
698///////////////////////////////////////////////////////////////////////////////}
699procedure TfrmEncounterFrame.FormCloseQuery(Sender: TObject;
700 var CanClose: Boolean);
701
702//const
703//TXT_SAVECHANGES = 'Save Changes?'; <-- original line. //kt 8/8/2007
704
705var
706 TmpPCEData: TPCEData;
707 ask, ChangeOK: boolean;
708
709begin
710 CanClose := True;
711 if(FAbort) then
712 FCancel := (InfoBox(TXT_SAVECHANGES, TXT_SAVECHANGES, MB_YESNO) = ID_NO);
713 if FCancel then Exit; //*KCM*
714
715 if(uProviders.PrimaryIdx >= 0) then
716 ask := TRUE
717 else
718 begin
719 TmpPCEData := TPCEData.Create;
720 try
721 uEncPCEData.CopyPCEData(TmpPCEData);
722 UpdateEncounter(TmpPCEData);
723 ask := TmpPCEData.NeedProviderInfo;
724 finally
725 TmpPCEData.Free;
726 end;
727 end;
728 if ask and (NoPrimaryPCEProvider(uProviders, uEncPCEData)) then
729 begin
730 InfoBox(TX_PROV_REQ, TC_PROV_REQ, MB_OK or MB_ICONWARNING);
731 CanClose := False;
732 Exit;
733 end;
734
735 uVisitType.Provider := uProviders.PrimaryIEN; {RV - v20.1}
736
737 if FormListContains(CT_VitNm) then
738 CanClose := frmEncVitals.OK2SaveVitals;
739
740 if CanClose and FormListContains(CT_ProcNm) then
741 begin
742 CanClose := frmProcedures.OK2SaveProcedures;
743 if not CanClose then
744 begin
745 tabPageChange(Self, FormList.IndexOf(CT_ProcNm), ChangeOK);
746 SwitchToPage(PageIDToForm(CT_PROCEDURES));
747 TabControl.TabIndex := FormList.IndexOf(CT_ProcNm);
748 end;
749 end;
750
751 if CanClose then SendData; //*KCM*
752
753end;
754
755procedure TfrmEncounterFrame.TabControlChange(Sender: TObject);
756var
757 i: integer;
758begin
759//must switch based on caption, as all tabs may not be present.
760 if (sender as tTabControl).tabindex = -1 then exit;
761
762 for i := CT_FIRST to CT_LAST do
763 begin
764 with Formlist do
765 with sender as tTabControl do
766 if Tabindex = IndexOf(PageIdToTab(i)) then
767 begin
768 PageIDToForm(i).show;
769 SwitchToPage(PageIDToForm(i));
770 end;
771 end;
772end;
773
774procedure TfrmEncounterFrame.TabControlChanging(Sender: TObject;
775 var AllowChange: Boolean);
776begin
777 if(assigned(FLastPage)) then
778 FLastPage.AllowTabChange(AllowChange);
779end;
780
781procedure TfrmEncounterFrame.UpdateEncounter(PCE: TPCEData);
782begin
783 with PCE do
784 begin
785 if FormListContains(CT_VisitNm) then
786 begin
787 VisitType := uVisitType;
788 frmVisitType.fraVisitRelated.GetRelated(uEncPCEData);
789 Providers.Merge(uProviders);
790 end;
791
792 if FormListContains(CT_DiagNm) then
793 SetDiagnoses(frmDiagnoses.lbGrid.Items);
794 if FormListContains(CT_ProcNm) then
795 SetProcedures(frmProcedures.lbGrid.Items);
796 if FormListContains(CT_ImmNm) then
797 SetImmunizations(frmImmunizations.lbGrid.Items);
798 if FormListContains(CT_SkinNm) then
799 SetSkinTests(frmSkinTests.lbGrid.Items);
800 if FormListContains(CT_PedNm) then
801 SetPatientEds(frmPatientEd.lbGrid.Items);
802 if FormListContains(CT_HlthNm) then
803 SetHealthFactors(frmHealthFactors.lbGrid.Items);
804 if FormListContains(CT_XamNm) then
805 SetExams(frmExams.lbGrid.Items);
806 end;
807end;
808
809procedure TfrmEncounterFrame.SelectTab(NewTabName: string);
810var
811 AllowChange: boolean;
812begin
813 AllowChange := True;
814 tabControl.TabIndex := FormList.IndexOf(NewTabName);
815 tabPageChange(Self, tabControl.TabIndex, AllowChange);
816end;
817
818procedure TfrmEncounterFrame.TabControlExit(Sender: TObject);
819var
820 i: integer;
821begin
822 //Keep the focus on the active page
823 if (sender as tTabControl).tabindex = -1 then exit;
824
825 for i := CT_FIRST to CT_LAST do
826 begin
827 with Formlist do
828 with sender as tTabControl do
829 if Tabindex = IndexOf(PageIdToTab(i)) then
830 begin
831 PageIDToForm(i).FocusFirstControl;
832 end;
833 end;
834end;
835
836procedure TfrmEncounterFrame.FormKeyDown(Sender: TObject; var Key: Word;
837 Shift: TShiftState);
838var
839 CanChange: boolean;
840begin
841 if (Key = VK_ESCAPE) then
842 begin
843 Key := 0;
844 FLastPage.btnCancel.Click;
845 end
846 else if Key = VK_TAB then
847 begin
848 if ssCtrl in Shift then
849 begin
850 CanChange := True;
851 if Assigned(TabControl.OnChanging) then
852 TabControl.OnChanging(TabControl, CanChange);
853 if CanChange then
854 begin
855 if ssShift in Shift then
856 begin
857 if TabControl.TabIndex < 1 then
858 TabControl.TabIndex := TabControl.Tabs.Count -1
859 else
860 TabControl.TabIndex := TabControl.TabIndex - 1;
861 end
862 else
863 TabControl.TabIndex := (TabControl.TabIndex + 1) mod TabControl.Tabs.Count;
864 if Assigned(TabControl.OnChange) then
865 TabControl.OnChange(TabControl);
866 end;
867 Key := 0;
868 end;
869 end;
870 if FLastPage = frmEncVitals then
871 frmEncVitals.FormKeyDown(Sender, Key, Shift);
872end;
873
874procedure TfrmEncounterFrame.SetFormFonts;
875var
876 NewFontSize: integer;
877begin
878 NewFontSize := MainFontsize;
879 if FormListContains(CT_VisitNm) then
880 frmVisitType.Font.Size := NewFontSize;
881 if FormListContains(CT_DiagNm) then
882 frmDiagnoses.Font.Size := NewFontSize;
883 if FormListContains(CT_ProcNm) then
884 frmProcedures.Font.Size := NewFontSize;
885 if FormListContains(CT_ImmNm) then
886 frmImmunizations.Font.Size := NewFontSize;
887 if FormListContains(CT_SkinNm) then
888 frmSkinTests.Font.Size := NewFontSize;
889 if FormListContains(CT_PedNm) then
890 frmPatientEd.Font.Size := NewFontSize;
891 if FormListContains(CT_HlthNm) then
892 frmHealthFactors.Font.Size := NewFontSize;
893 if FormListContains(CT_XamNm) then
894 frmExams.Font.Size := NewFontSize;
895 if FormListContains(CT_VitNm) then
896 frmEncVitals.Font.Size := NewFontSize;
897 if FormListContains(CT_GAFNm) then
898 frmGAF.SetFontSize(NewFontSize);
899end;
900
901procedure TfrmEncounterFrame.FormClose(Sender: TObject;
902 var Action: TCloseAction);
903begin
904 SaveUserBounds(Self);
905end;
906
907procedure TfrmEncounterFrame.FormCanResize(Sender: TObject; var NewWidth,
908 NewHeight: Integer; var Resize: Boolean);
909begin
910 //CQ4740
911 if NewWidth < 200 then
912 begin
913 NewWidth := 200;
914 Resize := false;
915 end;
916end;
917
918end.
Note: See TracBrowser for help on using the repository browser.