Module

fDCSummProps

Path

C:\CPRS\CPRS30\fDCSummProps.pas

Last Modified

7/15/2014 3:26:36 PM

Units Used in Interface

Name Comments
fBase508Form -
rDCSumm -
rTIU -
uConst -
uDCSumm -
uDocTree -
uTIU -

Units Used in Implementation

Name Comments
rCore -
rMisc -
rPCE -
uCore -
uPCE -

Classes

Name Comments
TfrmDCSummProperties -

Procedures

Name Owner Declaration Scope Comments
cboAttendingExit TfrmDCSummProperties procedure cboAttendingExit(Sender: TObject); Public/Published Make sure FCosign fields stay up to date in case SetCosigner gets called again
cboAttendingNeedData TfrmDCSummProperties procedure cboAttendingNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboAuthorEnter TfrmDCSummProperties procedure cboAuthorEnter(Sender: TObject); Public/Published -
cboAuthorExit TfrmDCSummProperties procedure cboAuthorExit(Sender: TObject); Public/Published -
cboAuthorMouseClick TfrmDCSummProperties procedure cboAuthorMouseClick(Sender: TObject); Public/Published -
cboAuthorNeedData TfrmDCSummProperties procedure cboAuthorNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published CboAuthor & cboAttending events
cboNewTitleChange TfrmDCSummProperties procedure cboNewTitleChange(Sender: TObject); Public/Published -
cboNewTitleDblClick TfrmDCSummProperties procedure cboNewTitleDblClick(Sender: TObject); Public/Published -
cboNewTitleDropDownClose TfrmDCSummProperties procedure cboNewTitleDropDownClose(Sender: TObject); Public/Published -
cboNewTitleEnter TfrmDCSummProperties procedure cboNewTitleEnter(Sender: TObject); Public/Published -
cboNewTitleExit TfrmDCSummProperties procedure cboNewTitleExit(Sender: TObject); Public/Published -
cboNewTitleMouseClick TfrmDCSummProperties procedure cboNewTitleMouseClick(Sender: TObject); Public/Published -
cboNewTitleNeedData TfrmDCSummProperties procedure cboNewTitleNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published CboNewTitle events
cmdCancelClick TfrmDCSummProperties procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmDCSummProperties procedure cmdOKClick(Sender: TObject); Public/Published Command Button events
FormClose TfrmDCSummProperties procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormShow TfrmDCSummProperties procedure FormShow(Sender: TObject); Public/Published Form events
lstAdmissionsChange TfrmDCSummProperties procedure lstAdmissionsChange(Sender: TObject); Public/Published -
SetCosignerRequired TfrmDCSummProperties procedure SetCosignerRequired; Private
General calls 

 called initially & whenever title or author changes
ShowAdmissionList TfrmDCSummProperties procedure ShowAdmissionList; Private -
UMDelayEvent TfrmDCSummProperties procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT; Private
Let the window finish displaying before dropping list box, otherwise listbox drop
  in the design position rather then new windows position (ORCtrls bug?)

Functions

Name Owner Declaration Scope Comments
ExecuteDCSummProperties - function ExecuteDCSummProperties(var ASumm: TEditDCSummRec; var ListBoxItem: string; ShowAdmissions, IDNoteTitlesOnly: boolean): Boolean; Interfaced -

Global Variables

Name Type Declaration Comments
EditLines TStringList EditLines: TStringList; -

Constants

Name Declaration Scope Comments
TC_EDIT_EXISTING 'Unsigned document in progress' Global -
TC_NO_EDIT 'Unable to Edit' Global -
TC_REQ_FIELDS 'Required Information' Global -
TX_BAD_ADMISSION CRLF + 'Admission information is missing or invalid.' Global -
TX_COS_AUTH CRLF + ' is not authorized to cosign this document.' Global -
TX_COS_SELF CRLF + 'You cannot make yourself a cosigner.' Global -
TX_EDIT_EXISTING 'Would you like to continue editing the existing unsigned summary for this admission?' Global -
TX_NO_ADMISSION CRLF + 'An admission must be selected' Global -
TX_NO_FUTURE CRLF + 'A reference date/time in the future is not allowed.' Global -
TX_NO_MORE_SUMMS CRLF + 'Only one discharge summary may be written for each admission.' Global -
TX_REQ_AUTHOR CRLF + 'The author of the note must be identified.' Global -
TX_REQ_COSIGNER CRLF + 'An attending must be identified.' Global -
TX_REQ_REFDATE CRLF + 'A valid date/time for the note must be entered.' Global -
TX_REQ_TITLE CRLF + 'A title must be selected.' Global -


Module Source

1     unit fDCSummProps;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORDtTm, ORCtrls, ExtCtrls, uConst, rTIU, rDCSumm, uDocTree, uDCSumm,
8       uTIU, fBase508Form, VA508AccessibilityManager;
9     
10    type
11      TfrmDCSummProperties = class(TfrmBase508Form)
12        bvlConsult: TBevel;
13        pnlFields: TORAutoPanel;
14        lblNewTitle: TLabel;
15        lblDateTime: TLabel;
16        lblAuthor: TLabel;
17        lblCosigner: TLabel;
18        cboNewTitle: TORComboBox;
19        calSumm: TORDateBox;
20        cboAuthor: TORComboBox;
21        cboAttending: TORComboBox;
22        pnlTranscription: TORAutoPanel;
23        lblTranscriptionist: TLabel;
24        lblUrgency: TLabel;
25        cboTranscriptionist: TORComboBox;
26        cboUrgency: TORComboBox;
27        pnlAdmissions: TORAutoPanel;
28        cmdOK: TButton;
29        cmdCancel: TButton;
30        pnlLabels: TORAutoPanel;
31        lblDCSumm1: TStaticText;
32        lblDCSumm2: TStaticText;
33        lblLocation: TLabel;
34        lblDate: TLabel;
35        lblType: TLabel;
36        lblSummStatus: TLabel;
37        lstAdmissions: TORListBox;
38        procedure FormShow(Sender: TObject);
39        procedure cboNewTitleNeedData(Sender: TObject; const StartFrom: String;
40          Direction, InsertAt: Integer);
41        procedure cboAuthorNeedData(Sender: TObject; const StartFrom: String;
42          Direction, InsertAt: Integer);
43        procedure cboAttendingNeedData(Sender: TObject; const StartFrom: String;
44          Direction, InsertAt: Integer);
45        procedure cmdOKClick(Sender: TObject);
46        procedure cmdCancelClick(Sender: TObject);
47        procedure cboNewTitleExit(Sender: TObject);
48        procedure cboNewTitleMouseClick(Sender: TObject);
49        procedure cboNewTitleEnter(Sender: TObject);
50        procedure cboAttendingExit(Sender: TObject);
51        procedure cboAuthorExit(Sender: TObject);
52        procedure cboAuthorMouseClick(Sender: TObject);
53        procedure cboAuthorEnter(Sender: TObject);
54        procedure cboNewTitleDropDownClose(Sender: TObject);
55        procedure lstAdmissionsChange(Sender: TObject);
56        procedure cboNewTitleDblClick(Sender: TObject);
57        procedure FormClose(Sender: TObject; var Action: TCloseAction);
58        procedure cboNewTitleChange(Sender: TObject);
59      private
60        FCosignIEN: Int64;      // store cosigner that was passed in
61        FCosignName: string;    // store cosigner that was passed in
62        FDocType: Integer;      // store document type that was passed in
63        FAddend: Integer;       // store IEN of note being addended (if make addendum)
64        FLastAuthor: Int64;     // set by mouseclick to avoid redundant call on exit
65        FLastTitle: Integer;    // set by mouseclick to avoid redundant call on exit
66        FAdmitDateTime: string  ;
67        FLocation: integer;
68        FLocationName: string;
69        FVisitStr: string;
70        FEditIEN: integer;
71        //FFixCursor: Boolean;    // to fix the problem where the list box is an I-bar
72        FLastCosigner: Int64;      // holds cosigner from previous note (for defaulting)
73        FLastCosignerName: string; // holds cosigner from previous note (for defaulting)
74        FShowAdmissions: Boolean;
75        FIDNoteTitlesOnly: boolean;
76        procedure SetCosignerRequired;
77        procedure ShowAdmissionList;
78        procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
79      public
80        { Public declarations }
81      end;
82    
83    function ExecuteDCSummProperties(var ASumm: TEditDCSummRec; var ListBoxItem: string; ShowAdmissions, IDNoteTitlesOnly: boolean): Boolean;
84    
85    var
86      EditLines: TStringList;
87    
88    implementation
89    
90    {$R *.DFM}
91    
92    uses ORFn, uCore, rCore, uPCE, rPCE, rMisc;
93    { Initial values in ASumm
94    
95                      Title  Type    Author  DateTime  Cosigner  Location  Consult  NeedCPT
96         New DCSumm    dflt   244      DUZ      NOW      dflt      Encnt      0        ?
97        Edit DCSumm    ien    244      ien     DtTm       ien       ien      ien      fld
98      Addend DCSumm    ien     81      DUZ      NOW        0        N/A      N/A?      no
99    
100     New Summ - setup as much as possible, then call ExecuteDCSummProperties if necessary.
101   
102   }
103   
104   const
105     TC_REQ_FIELDS   = 'Required Information';
106     TX_REQ_TITLE    = CRLF + 'A title must be selected.';
107     TX_REQ_AUTHOR   = CRLF + 'The author of the note must be identified.';
108     TX_REQ_REFDATE  = CRLF + 'A valid date/time for the note must be entered.';
109     TX_REQ_COSIGNER = CRLF + 'An attending must be identified.';
110     TX_NO_FUTURE    = CRLF + 'A reference date/time in the future is not allowed.';
111     TX_COS_SELF     = CRLF + 'You cannot make yourself a cosigner.';
112     TX_COS_AUTH     = CRLF + ' is not authorized to cosign this document.';
113     TX_BAD_ADMISSION = CRLF + 'Admission information is missing or invalid.';
114     TX_NO_ADMISSION  = CRLF + 'An admission must be selected';
115     TX_NO_MORE_SUMMS = CRLF + 'Only one discharge summary may be written for each admission.';
116     TC_NO_EDIT       = 'Unable to Edit';
117     TC_EDIT_EXISTING = 'Unsigned document in progress';
118     TX_EDIT_EXISTING = 'Would you like to continue editing the existing unsigned summary for this admission?';
119   
120   function ExecuteDCSummProperties(var ASumm: TEditDCSummRec; var ListBoxItem: string; ShowAdmissions, IDNoteTitlesOnly: boolean): Boolean;
121   var
122     frmDCSummProperties: TfrmDCSummProperties;
123     x: string;
124   begin
125     frmDCSummProperties := TfrmDCSummProperties.Create(Application);
126     EditLines := TStringList.Create;
127     try
128       ResizeAnchoredFormToFont(frmDCSummProperties);
129       with frmDCSummProperties do
130       begin
131         // setup common fields (title, reference date, author)
132         FShowAdmissions := ShowAdmissions;
133         FIDNoteTitlesOnly := IDNoteTitlesOnly;
134         pnlTranscription.Visible := False;    {was never used on old form}
135         if not pnlTranscription.Visible then
136           begin
137             Height := Height - pnlTranscription.Height;
138             Top := Top  - pnlTranscription.Height;
139           end;
140   //      Height := Height - pnlAdmissions.Height - pnlLabels.Height;
141         if ASumm.DocType <> TYP_ADDENDUM then
142           begin
143             cboNewTitle.InitLongList('');
144             ListDCSummTitlesShort(cboNewTitle.Items);
145           end
146         else //if addendum
147           cboNewTitle.Items.Insert(0, IntToStr(ASumm.Title) + U + ASumm.TitleName);
148         if ASumm.Title > 0 then cboNewTitle.SelectByIEN(ASumm.Title);
149         if (ASumm.Title > 0) and (cboNewTitle.ItemIndex < 0)
150           then cboNewTitle.SetExactByIEN(ASumm.Title, ASumm.TitleName);
151         cboAuthor.InitLongList(ASumm.DictatorName);
152         if ASumm.Dictator > 0 then cboAuthor.SelectByIEN(ASumm.Dictator);
153         FastAssign(LoadDCUrgencies, cboUrgency.Items);
154         cboUrgency.SelectByID('R');
155         if Asumm.Attending = 0 then
156           begin
157             ASumm.Attending  := FLastCosigner;
158             ASumm.AttendingName := FLastCosignerName;
159           end;
160         calSumm.FMDateTime := ASumm.DictDateTime;
161         if FShowAdmissions then ShowAdmissionList;
162         FAddend     := ASumm.Addend;
163         FDocType    := ASumm.DocType;
164         FLastCosigner     := ASumm.LastCosigner;
165         FLastCosignerName := ASumm.LastCosignerName;
166         FEditIEN    := 0;
167         cboAttending.InitLongList(ASumm.AttendingName);
168         if ASumm.Attending > 0 then cboAttending.SelectByIEN(ASumm.Attending);
169         // restrict edit of title if addendum
170         if FDocType = TYP_ADDENDUM then
171         begin
172           lblNewTitle.Caption := 'Addendum to:';
173           cboNewTitle.Caption := 'Addendum to:';
174           cboNewTitle.Enabled := False;
175           cboNewTitle.Color   := clBtnFace;
176         end;
177         Result := ShowModal = idOK;                // display the form
178         if Result then with ASumm do
179           begin
180             if FDocType <> TYP_ADDENDUM then
181             begin
182               Title := cboNewTitle.ItemIEN;
183               TitleName := PrintNameForTitle(Title);
184             end;
185             Urgency           := cboUrgency.ItemID;
186             DictDateTime      := calSumm.FMDateTime;
187             Dictator          := cboAuthor.ItemIEN;
188             DictatorName      := Piece(cboAuthor.Items[cboAuthor.ItemIndex], U, 2);
189             Attending         := cboAttending.ItemIEN;
190             AttendingName     := Piece(cboAttending.Items[cboAttending.ItemIndex], U, 2);
191             if Attending = Dictator then Cosigner := 0 else
192               begin
193                 Cosigner      := cboAttending.ItemIEN;
194                 CosignerName  := Piece(cboAttending.Items[cboAttending.ItemIndex], U, 2);
195                 // The LastCosigner fields are used to default the cosigner in subsequent notes.
196                 // These fields are not reset with new notes & not passed into TIU.
197                 LastCosigner :=  Cosigner;
198                 LastCosignerName := CosignerName;
199               end;
200             Transcriptionist  := cboTranscriptionist.ItemIEN;
201             if FShowAdmissions then
202               begin
203                 AdmitDateTime   := StrToFMDateTime(FAdmitDateTime);
204                 DischargeDateTime := StrToFMDateTime(GetDischargeDate(Patient.DFN, FAdmitDateTime));
205                 if DischargeDateTime <= 0 then DischargeDateTime := FMNow;
206                 Location          := FLocation;
207                 LocationName      := FLocationName;
208                 VisitStr          := IntToStr(Location) + ';' + FloatToStr(AdmitDateTime) + ';H' ;
209               end;
210             EditIEN           := FEditIEN;
211             if FEditIEN > 0 then
212               begin
213                 x := GetTIUListItem(FEditIEN);
214                 ListBoxItem := x;
215                 if Lines = nil then Lines := TStringList.Create;
216                 FastAssign(EditLines, Lines);
217               end
218             else
219               begin
220                 ListBoxItem := '';
221               end;
222           end;
223             // The following fields in TEditDCSummRec are not set:
224             //   DocType, NeedCPT, Lines (unless editing an existing summary)
225       end;
226     finally
227       EditLines.Free;
228       frmDCSummProperties.Release;
229     end;
230   end;
231   
232   { Form events }
233   
234   procedure TfrmDCSummProperties.FormShow(Sender: TObject);
235   begin
236     SetFormPosition(Self);
237     //if cboNewTitle.Text = '' then PostMessage(Handle, UM_DELAYEVENT, 0, 0);
238   end;
239   
240   procedure TfrmDCSummProperties.UMDelayEvent(var Message: TMessage);
241   { let the window finish displaying before dropping list box, otherwise listbox drop
242     in the design position rather then new windows position (ORCtrls bug?) }
243   begin
244   (*  Screen.Cursor := crArrow;
245     FFixCursor := TRUE;
246     cboNewTitle.DroppedDown := True;
247     lblDateTime.Visible := False;
248     lblAuthor.Visible   := False;
249     lblCosigner.Visible := False;*)
250   end;
251   
252   { General calls }
253   
254   procedure TfrmDCSummProperties.SetCosignerRequired;
255   { called initially & whenever title or author changes }
256   begin
257   (*  if FDocType = TYP_ADDENDUM then
258     begin
259       lblCosigner.Visible := AskCosignerForDocument(FAddend, cboAuthor.ItemIEN)
260     end else
261     begin
262       if cboNewTitle.ItemIEN = 0
263         then lblCosigner.Visible := AskCosignerForTitle(FDocType,            cboAuthor.ItemIEN)
264         else lblCosigner.Visible := AskCosignerForTitle(cboNewTitle.ItemIEN, cboAuthor.ItemIEN);
265     end;*)
266     lblCosigner.Visible := True;
267     cboAttending.Visible := lblCosigner.Visible;
268   end;
269   
270   procedure TfrmDCSummProperties.ShowAdmissionList;
271   var
272     i, Status: integer;
273     x: string;
274   begin
275     with lstAdmissions do
276       begin
277         ListAdmitAll(Items, Patient.DFN);
278         if Items.Count > 0 then
279           begin
280             for i := 0 to Items.Count-1 do
281               begin
282                 x := Items[i];
283                 SetPiece(x, '^', 8, FormatFMDateTimeStr('mmm dd,yyyy  hh:nn', Piece(Items[i],U,1)));
284                 Status := StrToIntDef(Piece(Items[i],U,7),0);
285                 case Status of
286                   0: x := x + '^None on file';
287                   1: x := x + '^Completed';
288                   2: x := x + '^Unsigned';
289                 end;
290                 Items[i] := x;
291               end;
292           end
293         else
294           FAdmitDateTime := '-1^No admissions were found for this patient.';
295       end;
296   end;
297   
298   { cboNewTitle events }
299   
300   procedure TfrmDCSummProperties.cboNewTitleNeedData(Sender: TObject; const StartFrom: string;
301     Direction, InsertAt: Integer);
302   begin
303     cboNewTitle.ForDataUse(SubSetOfDCSummTitles(StartFrom, Direction, FIDNoteTitlesOnly));
304   end;
305   
306   procedure TfrmDCSummProperties.cboNewTitleEnter(Sender: TObject);
307   begin
308     FLastTitle := 0;
309   end;
310   
311   procedure TfrmDCSummProperties.cboNewTitleMouseClick(Sender: TObject);
312   begin
313     with cboNewTitle do
314       if (ItemIEN > 0) and (ItemIEN = FLastTitle) then Exit
315       else if ItemIEN = 0 then
316         begin
317           if FLastTitle > 0 then SelectByIEN(FLastTitle)
318           else ItemIndex := -1;
319           Exit;
320         end;
321     SetCosignerRequired;
322     if FShowAdmissions and (not pnlAdmissions.Visible) then
323       begin
324   //      Height := Height + pnlAdmissions.Height + pnlLabels.Height;
325         pnlAdmissions.Visible := True;
326         pnlLabels.Visible := True;
327       end;
328     FLastTitle := cboNewTitle.ItemIEN;
329   end;
330   
331   procedure TfrmDCSummProperties.cboNewTitleExit(Sender: TObject);
332   begin
333     if cboNewTitle.ItemIEN <> FLastTitle then cboNewTitleMouseClick(Self);
334   end;
335   
336   { cboAuthor & cboAttending events }
337   
338   procedure TfrmDCSummProperties.cboAuthorNeedData(Sender: TObject; const StartFrom: String;
339     Direction, InsertAt: Integer);
340   begin
341     (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
342   end;
343   
344   procedure TfrmDCSummProperties.cboAttendingNeedData(Sender: TObject; const StartFrom: String;
345     Direction, InsertAt: Integer);
346   var TitleIEN: Int64;
347   begin
348   //  (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
349   
350   // CQ#11666
351   //  (Sender as TORComboBox).ForDataUse(SubSetOfCosigners(StartFrom, Direction,
352   //        FMToday, cboNewTitle.ItemIEN, FDocType));
353   
354   // CQ #17218 - Updated to properly filter co-signers - JCS
355     TitleIEN := cboNewTitle.ItemIEN;
356     if TitleIEN = 0 then TitleIEN := FDocType;
357   
358     (Sender as TORComboBox).ForDataUse(SubSetOfCosigners(StartFrom, Direction,
359           FMToday, TitleIEN, 0));
360   end;
361   
362   procedure TfrmDCSummProperties.cboAuthorEnter(Sender: TObject);
363   begin
364     FLastAuthor := 0;
365   end;
366   
367   procedure TfrmDCSummProperties.cboAuthorMouseClick(Sender: TObject);
368   begin
369     SetCosignerRequired;
370     FLastAuthor := cboAuthor.ItemIEN;
371   end;
372   
373   procedure TfrmDCSummProperties.cboAuthorExit(Sender: TObject);
374   begin
375     if cboAuthor.ItemIEN <> FLastAuthor then cboAuthorMouseClick(Self);
376   end;
377   
378   procedure TfrmDCSummProperties.cboAttendingExit(Sender: TObject);
379   { make sure FCosign fields stay up to date in case SetCosigner gets called again }
380   begin
381     with cboAttending do if Text = '' then ItemIndex := -1;
382     if cboAttending.ItemIndex < 0 then
383     begin
384       FCosignIEN := 0;
385       FCosignName := '';
386     end
387     else
388     begin
389       FCosignIEN := cboAttending.ItemIEN;
390       FCosignName := Piece(cboAttending.Items[cboAttending.ItemIndex], U, 2);
391     end;
392   end;
393   
394   { Command Button events }
395   
396   procedure TfrmDCSummProperties.cmdOKClick(Sender: TObject);
397   var
398     ErrMsg, x, WhyNot: string;
399   begin
400     cmdOK.SetFocus;                                // make sure cbo exit events fire
401     Application.ProcessMessages;
402     SetCosignerRequired;
403     ErrMsg := '';
404     if cboNewTitle.ItemIEN = 0 then
405       ErrMsg := ErrMsg + TX_REQ_TITLE
406     else if FIDNoteTitlesOnly and (not CanTitleBeIDChild(cboNewTitle.ItemIEN, WhyNot)) then
407       ErrMsg := ErrMsg + CRLF + WhyNot;
408     if cboAuthor.ItemIEN = 0   then ErrMsg := ErrMsg + TX_REQ_AUTHOR;
409     if not calSumm.IsValid     then ErrMsg := ErrMsg + TX_REQ_REFDATE;
410     if calSumm.IsValid and (calSumm.FMDateTime > FMNow)    then ErrMsg := ErrMsg + TX_NO_FUTURE;
411     if cboAttending.Visible and (cboAttending.ItemIEN = 0)   then ErrMsg := ErrMsg + TX_REQ_COSIGNER;
412     //if cboAttending.ItemIEN = User.DUZ                      then ErrMsg := TX_COS_SELF;
413   
414   // --------------------------------- REPLACED THIS BLOCK IN V27.37-----------------------------------------------
415   /// if (cboAttending.ItemIEN > 0) and not IsUserAProvider(cboAttending.ItemIEN, FMNow) then
416   //  //if (cboAttending.ItemIEN > 0) and not CanCosign(cboNewTitle.ItemIEN, FDocType, cboAttending.ItemIEN) then
417   //   ErrMsg := cboAttending.Text + TX_COS_AUTH;
418   // ------------------------------------ NEW CODE FOLLOWS --------------------------------------------------------
419     if (cboAttending.ItemIEN > 0) then
420        if ((not IsUserAUSRProvider(cboAttending.ItemIEN, FMNow)) or
421           (not CanCosign(cboNewTitle.ItemIEN, FDocType, cboAttending.ItemIEN, calSumm.FMDateTime))) then
422        ErrMsg := cboAttending.Text + TX_COS_AUTH;
423   // -----------------------------------END OF NEW REPLACEMENT CODE -----------------------------------------------
424   
425     if pnlAdmissions.Visible then
426     with lstAdmissions do
427     begin
428       if ItemIndex < 0 then
429         ErrMsg := TX_NO_ADMISSION
430       else if (Piece(x, U, 7) = '1') then
431         begin
432           x := Items[ItemIndex];
433           FVisitStr := Piece(x, U, 2) + ';' + Piece(x, U, 1) + ';H';
434           if (OneNotePerVisit(cboNewTitle.ItemIEN, Patient.DFN, FVisitStr)) then
435             begin
436               FEditIEN := 0;
437               InfoBox(TX_NO_MORE_SUMMS, TC_NO_EDIT, MB_OK);
438               lstAdmissions.ItemIndex := -1;
439             end;
440         end
441       else
442         begin
443           x := Items[ItemIndex];
444           FAdmitDateTime := Piece(x,U,1);
445           FLocation := StrToIntDef(Piece(x, U, 2), 0);
446           if (MakeFMDateTime(FAdmitDateTime)= -1) or (FLocation = 0)  then
447             ErrMsg := TX_BAD_ADMISSION
448           else
449             FLocationName := ExternalName(FLocation, 44);
450         end;
451     end;
452   
453     if ShowMsgOn(Length(ErrMsg) > 0, ErrMsg, TC_REQ_FIELDS)
454       then Exit
455       else ModalResult := mrOK;
456   end;
457   
458   procedure TfrmDCSummProperties.cmdCancelClick(Sender: TObject);
459   begin
460     ModalResult := mrCancel;
461     Close;
462   end;
463   
464   procedure TfrmDCSummProperties.cboNewTitleDropDownClose(Sender: TObject);
465   begin
466   (*  if FFixCursor then
467     begin
468       Screen.Cursor := crDefault;
469       FFixCursor := FALSE;
470     end;
471     lblDateTime.Visible := True;
472     lblAuthor.Visible   := True;
473     lblCosigner.Visible := True;*)
474   end;
475   
476   procedure TfrmDCSummProperties.lstAdmissionsChange(Sender: TObject);
477   var
478     x: string;
479     AnEditSumm: TEditDCSummRec;
480     ActionSts: TActionRec;
481   begin
482     if lstAdmissions.ItemIndex < 0 then Exit;
483     x := lstAdmissions.Items[lstAdmissions.ItemIndex];
484     if (StrToIntDef(Piece(x, U, 7), 0) = 2) then
485       begin
486         { Prompt for edit first - proceed as below if yes, else proceed as if '1'}
487         if InfoBox(TX_EDIT_EXISTING, TC_EDIT_EXISTING, MB_YESNO) = MRYES then
488         begin
489           FillChar(AnEditSumm, SizeOf(AnEditSumm), 0);
490           FEditIEN := StrToInt(Piece(x,U,6));
491           ActOnDCDocument(ActionSts, FEditIEN, 'EDIT RECORD');
492           if not ActionSts.Success then
493           begin
494             InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
495             lstAdmissions.ItemIndex := -1;
496             Exit;
497           end;
498           GetDCSummForEdit(AnEditSumm, FEditIEN);
499           EditLines.Assign(AnEditSumm.Lines);
500           cboNewTitle.InitLongList(AnEditSumm.TitleName);
501           ListDCSummTitlesShort(cboNewTitle.Items);
502           if AnEditSumm.Title > 0 then cboNewTitle.SelectByIEN(AnEditSumm.Title);
503           cboAuthor.InitLongList(AnEditSumm.DictatorName);
504           if AnEditSumm.Dictator > 0 then cboAuthor.SelectByIEN(AnEditSumm.Dictator);
505           FastAssign(LoadDCUrgencies, cboUrgency.Items);
506           cboUrgency.SelectByID('R');
507           cboAttending.InitLongList(AnEditSumm.AttendingName);
508           if AnEditSumm.Attending > 0 then cboAttending.SelectByIEN(AnEditSumm.Attending);
509           calSumm.FMDateTime := AnEditSumm.DictDateTime;
510         end
511         else // if user answers NO to edit existing document, can new one be created?
512           begin
513             FVisitStr := Piece(x, U, 2) + ';' + Piece(x, U, 1) + ';H';
514             if (OneNotePerVisit(cboNewTitle.ItemIEN, Patient.DFN, FVisitStr)) then
515             begin
516               FEditIEN := 0;
517               InfoBox(TX_NO_MORE_SUMMS, TC_NO_EDIT, MB_OK);
518               lstAdmissions.ItemIndex := -1;
519             end;
520           end;
521       end
522     else if Piece(x, U, 7) = '1' then
523       begin
524         FVisitStr := Piece(x, U, 2) + ';' + Piece(x, U, 1) + ';H';
525         if (OneNotePerVisit(cboNewTitle.ItemIEN, Patient.DFN, FVisitStr)) then
526         begin
527           FEditIEN := 0;
528           InfoBox(TX_NO_MORE_SUMMS, TC_NO_EDIT, MB_OK);
529           lstAdmissions.ItemIndex := -1;
530         end;
531       end
532     else
533       begin
534         FEditIEN := 0;
535   (*      cboNewTitle.ItemIndex := -1;
536         cboAttending.ItemIndex := -1;
537         calSumm.FMDateTime := FMNow;*)
538       end;
539   end;
540   
541   procedure TfrmDCSummProperties.cboNewTitleChange(Sender: TObject);
542   var
543     IEN: Int64;
544     name: string;
545     Index: Integer;
546   
547   begin
548     inherited;
549     index := cboAttending.ItemIndex;
550     if index >= 0 then
551     begin
552       IEN := cboAttending.ItemIEN;
553       name := cboAttending.DisplayText[index];
554     end
555     else
556     begin
557       name := '';
558       IEN := 0;
559     end;
560     cboAttending.InitLongList(name);
561     if index >= 0 then
562       cboAttending.SelectByIEN(IEN);
563   end;
564   
565   procedure TfrmDCSummProperties.cboNewTitleDblClick(Sender: TObject);
566   begin
567     cmdOKClick(Self);
568   end;
569   
570   procedure TfrmDCSummProperties.FormClose(Sender: TObject;
571     var Action: TCloseAction);
572   begin
573     SaveUserBounds(Self);
574   end;
575   
576   end.

Module Calls (2 levels)


fDCSummProps
 ├uConst
 ├rTIU
 │ ├rCore
 │ ├uCore
 │ ├uConst
 │ ├uTIU
 │ └rMisc
 ├rDCSumm
 │ ├rCore...
 │ ├uCore...
 │ ├rTIU...
 │ ├uConst
 │ ├uTIU
 │ └uDCSumm
 ├uDCSumm
 ├uTIU
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uCore...
 ├rCore...
 ├uPCE
 │ ├uConst
 │ ├uCore...
 │ ├rPCE
 │ ├rCore...
 │ ├rTIU...
 │ ├fEncounterFrame
 │ ├uVitals
 │ ├fFrame
 │ ├fPCEProvider
 │ └rVitals
 ├rPCE...
 └rMisc...

Module Called-By (2 levels)


    fDCSummProps
       fDCSumm┘ 
      fFrame┤   
  fPrintList┤   
     fReview┤   
fAddlSigners┘