1 | unit fProbEdt;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | SysUtils, windows, Messages, Classes, Graphics, Controls,
|
---|
7 | Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Grids,
|
---|
8 | ORCtrls, Vawrgrid, uCore, Menus, uConst;
|
---|
9 |
|
---|
10 | const
|
---|
11 | SOC_QUIT = 1; { close single dialog }
|
---|
12 |
|
---|
13 | type
|
---|
14 | TfrmdlgProb = class(TForm)
|
---|
15 | Label1: TLabel;
|
---|
16 | Label5: TLabel;
|
---|
17 | edResDate: TCaptionEdit;
|
---|
18 | Label7: TLabel;
|
---|
19 | edUpdate: TCaptionEdit;
|
---|
20 | pnlBottom: TPanel;
|
---|
21 | bbQuit: TBitBtn;
|
---|
22 | bbFile: TBitBtn;
|
---|
23 | pnlComments: TPanel;
|
---|
24 | Bevel1: TBevel;
|
---|
25 | lblCmtDate: TOROffsetLabel;
|
---|
26 | lblComment: TOROffsetLabel;
|
---|
27 | lblCom: TStaticText;
|
---|
28 | bbAdd: TBitBtn;
|
---|
29 | bbRemove: TBitBtn;
|
---|
30 | lstComments: TORListBox;
|
---|
31 | bbEdit: TBitBtn;
|
---|
32 | pnlTop: TPanel;
|
---|
33 | lblAct: TLabel;
|
---|
34 | rgStatus: TKeyClickRadioGroup;
|
---|
35 | rgStage: TKeyClickRadioGroup;
|
---|
36 | bbChangeProb: TBitBtn;
|
---|
37 | edProb: TCaptionEdit;
|
---|
38 | gbTreatment: TGroupBox;
|
---|
39 | ckSC: TCheckBox;
|
---|
40 | ckRad: TCheckBox;
|
---|
41 | ckAO: TCheckBox;
|
---|
42 | ckENV: TCheckBox;
|
---|
43 | ckHNC: TCheckBox;
|
---|
44 | ckMST: TCheckBox;
|
---|
45 | ckVerify: TCheckBox;
|
---|
46 | edRecDate: TCaptionEdit;
|
---|
47 | cbServ: TORComboBox;
|
---|
48 | cbLoc: TORComboBox;
|
---|
49 | lblLoc: TLabel;
|
---|
50 | cbProv: TORComboBox;
|
---|
51 | Label3: TLabel;
|
---|
52 | edOnsetdate: TCaptionEdit;
|
---|
53 | Label6: TLabel;
|
---|
54 | procedure bbQuitClick(Sender: TObject);
|
---|
55 | procedure bbAddComClick(Sender: TObject);
|
---|
56 | procedure FormShow(Sender: TObject);
|
---|
57 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
58 | procedure bbFileClick(Sender: TObject);
|
---|
59 | procedure bbRemoveClick(Sender: TObject);
|
---|
60 | procedure cbProvKeyPress(Sender: TObject; var Key: Char);
|
---|
61 | procedure rgStatusClick(Sender: TObject);
|
---|
62 | procedure cbProvClick(Sender: TObject);
|
---|
63 | procedure cbLocClick(Sender: TObject);
|
---|
64 | procedure cbLocKeyPress(Sender: TObject; var Key: Char);
|
---|
65 | procedure SetDefaultProb(Alist:TstringList;prob:string);
|
---|
66 | procedure ControlChange(Sender: TObject);
|
---|
67 | function BadDates:Boolean;
|
---|
68 | procedure cbProvDropDown(Sender: TObject);
|
---|
69 | procedure cbLocDropDown(Sender: TObject);
|
---|
70 | procedure FormCreate(Sender: TObject);
|
---|
71 | procedure bbChangeProbClick(Sender: TObject);
|
---|
72 | procedure cbLocNeedData(Sender: TObject; const StartFrom: String;
|
---|
73 | Direction, InsertAt: Integer);
|
---|
74 | procedure cbProvNeedData(Sender: TObject; const StartFrom: String;
|
---|
75 | Direction, InsertAt: Integer);
|
---|
76 | procedure cbServNeedData(Sender: TObject; const StartFrom: String;
|
---|
77 | Direction, InsertAt: Integer);
|
---|
78 | procedure bbEditClick(Sender: TObject);
|
---|
79 | private
|
---|
80 | { Private declarations }
|
---|
81 | FEditing: Boolean;
|
---|
82 | FInitialShow: Boolean;
|
---|
83 | FModified: Boolean;
|
---|
84 | FProviderID: Int64;
|
---|
85 | FLocationID: Longint;
|
---|
86 | FDisplayGroupID: Integer;
|
---|
87 | FInitialFocus: TWinControl;
|
---|
88 | FCtrlMap: TStringList;
|
---|
89 | FSourceOfClose: Integer;
|
---|
90 | FOnInitiate: TNotifyEvent;
|
---|
91 | fChanged:boolean;
|
---|
92 | FSilent: boolean;
|
---|
93 | FCanQuit: boolean;
|
---|
94 |
|
---|
95 | procedure UMTakeFocus(var Message: TMessage); message UM_TAKEFOCUS;
|
---|
96 | procedure ShowComments;
|
---|
97 | procedure GetEditedComments;
|
---|
98 | procedure GetNewComments(Reason:char);
|
---|
99 | function OkToQuit:boolean;
|
---|
100 | protected
|
---|
101 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
102 | procedure DoShow; override;
|
---|
103 | procedure Loaded; override;
|
---|
104 | procedure ClearDialogControls; virtual;
|
---|
105 | function LackRequired: Boolean; virtual;
|
---|
106 | procedure LoadDefaults; virtual;
|
---|
107 | property InitialFocus: TWinControl read FInitialFocus write FInitialFocus;
|
---|
108 | public
|
---|
109 | { Public declarations }
|
---|
110 | Reason:Char;
|
---|
111 | problemIFN:String;
|
---|
112 | subjProb:string; {parameters for problem being added}
|
---|
113 | constructor Create(AOwner: TComponent); override ;
|
---|
114 | destructor Destroy; override;
|
---|
115 | property DisplayGroupID: Integer read FDisplayGroupID write FDisplayGroupID;
|
---|
116 | property Editing: Boolean read FEditing write FEditing;
|
---|
117 | property Silent: Boolean read FSilent write FSilent;
|
---|
118 | property ProviderID: Int64 read FProviderID write FProviderID;
|
---|
119 | property LocationID: Longint read FLocationID write FLocationID;
|
---|
120 | property SourceOfClose: Integer read FSourceOfClose write FSourceOfClose;
|
---|
121 | property OnInitiate: TNotifyEvent read FOnInitiate write FOnInitiate;
|
---|
122 | procedure SetFontSize( NewFontSize: integer);
|
---|
123 | property CanQuit: boolean read FCanQuit write FCanQuit;
|
---|
124 | end ;
|
---|
125 |
|
---|
126 | implementation
|
---|
127 |
|
---|
128 | {$R *.DFM}
|
---|
129 |
|
---|
130 | uses ORFn, uProbs, fProbs, rProbs, fCover, rCover, rCore, fProbCmt, fProbLex, rPCE, uInit ;
|
---|
131 |
|
---|
132 | type
|
---|
133 | TDialogItem = class { for loading edits & quick orders }
|
---|
134 | ControlName: string;
|
---|
135 | DialogPtr: Integer;
|
---|
136 | Instance: Integer;
|
---|
137 | end;
|
---|
138 |
|
---|
139 | function TfrmdlgProb.OkToQuit:boolean;
|
---|
140 | begin
|
---|
141 | Result := not fChanged;
|
---|
142 | end;
|
---|
143 |
|
---|
144 | procedure TfrmdlgProb.bbQuitClick(Sender: TObject);
|
---|
145 | begin
|
---|
146 | if OkToQuit then
|
---|
147 | begin
|
---|
148 | frmProblems.lblProbList.caption := frmProblems.pnlRight.Caption ;
|
---|
149 | close;
|
---|
150 | end
|
---|
151 | else
|
---|
152 | begin
|
---|
153 | if (not FSilent) and
|
---|
154 | (InfoBox('Discard changes?', 'Add/Edit a Problem', MB_YESNO or MB_ICONQUESTION) <> IDYES) then
|
---|
155 | begin
|
---|
156 | FCanQuit := False;
|
---|
157 | exit;
|
---|
158 | end
|
---|
159 | else
|
---|
160 | begin
|
---|
161 | frmProblems.lblProbList.caption := frmProblems.pnlRight.Caption ;
|
---|
162 | FCanQuit := True;
|
---|
163 | close;
|
---|
164 | end;
|
---|
165 | end;
|
---|
166 | end;
|
---|
167 |
|
---|
168 | procedure TfrmdlgProb.bbAddComClick(Sender: TObject);
|
---|
169 | var
|
---|
170 | cmt: string ;
|
---|
171 | begin
|
---|
172 | cmt := NewComment ;
|
---|
173 | if StrToInt(Piece(cmt, U, 1)) > 0 then
|
---|
174 | begin
|
---|
175 | lstComments.Items.Add(Pieces(cmt, U, 2, 3)) ;
|
---|
176 | fChanged := true;
|
---|
177 | end ;
|
---|
178 | end;
|
---|
179 |
|
---|
180 | procedure TfrmdlgProb.bbEditClick(Sender: TObject);
|
---|
181 | var
|
---|
182 | cmt: string ;
|
---|
183 | begin
|
---|
184 | if lstComments.ItemIndex < 0 then Exit;
|
---|
185 | cmt := EditComment(lstComments.Items[lstComments.ItemIndex]) ;
|
---|
186 | if StrToInt(Piece(cmt, U, 1)) > 0 then
|
---|
187 | begin
|
---|
188 | lstComments.Items[lstComments.ItemIndex] := Pieces(cmt, U, 2, 3) ;
|
---|
189 | fChanged := true;
|
---|
190 | end ;
|
---|
191 | end;
|
---|
192 |
|
---|
193 | procedure TfrmdlgProb.FormShow(Sender: TObject);
|
---|
194 | var
|
---|
195 | alist: TstringList;
|
---|
196 | Anchorses: Array of TAnchors;
|
---|
197 | i: integer;
|
---|
198 | begin
|
---|
199 | if ProbRec <> nil then exit;
|
---|
200 | if (ResizeWidth(Font,MainFont,Width) >= Parent.ClientWidth) and
|
---|
201 | (ResizeHeight(Font,MainFont,Height) >= Parent.ClientHeight) then
|
---|
202 | begin //This form won't fit when it resizes, so we have to take Drastic Measures
|
---|
203 | SetLength(Anchorses, dlgProbs.ControlCount);
|
---|
204 | for i := 0 to ControlCount - 1 do
|
---|
205 | begin
|
---|
206 | Anchorses[i] := Controls[i].Anchors;
|
---|
207 | Controls[i].Anchors := [akLeft, akTop];
|
---|
208 | end;
|
---|
209 | SetFontSize(MainFontSize);
|
---|
210 | RequestAlign;
|
---|
211 | for i := 0 to ControlCount - 1 do
|
---|
212 | Controls[i].Anchors := Anchorses[i];
|
---|
213 | end
|
---|
214 | else
|
---|
215 | begin
|
---|
216 | SetFontSize(MainFontSize);
|
---|
217 | RequestAlign;
|
---|
218 | end;
|
---|
219 | frmProblems.mnuView.Enabled := False;
|
---|
220 | frmProblems.mnuAct.Enabled := False ;
|
---|
221 | frmProblems.lstView.Enabled := False;
|
---|
222 | frmProblems.bbNewProb.Enabled := False ;
|
---|
223 | Alist := TstringList.create;
|
---|
224 | try
|
---|
225 | if Reason = 'E' then
|
---|
226 | lblact.caption := 'Editing:'
|
---|
227 | else if Reason = 'A' then
|
---|
228 | lblact.caption := 'Adding'
|
---|
229 | else {display, comment edit or remove problem}
|
---|
230 | begin
|
---|
231 | case reason of 'C','c': lblact.caption := 'Comment Edit';
|
---|
232 | 'R','r': lblact.caption := 'Remove Problem:';
|
---|
233 | end; {case}
|
---|
234 | {ckVerify.Enabled:=false;}
|
---|
235 | cbProv.Enabled := false;
|
---|
236 | cbLoc.Enabled := false;
|
---|
237 | bbRemove.enabled := false;
|
---|
238 | rgStatus.Enabled := false;
|
---|
239 | rgStage.Enabled := false;
|
---|
240 | edRecdate.enabled := false;
|
---|
241 | edResdate.enabled := false;
|
---|
242 | edOnsetDate.enabled := false;
|
---|
243 | ckSC.enabled := false;
|
---|
244 | ckRAD.enabled := false;
|
---|
245 | ckAO.enabled := false;
|
---|
246 | ckENV.enabled := false;
|
---|
247 | ckHNC.enabled := false;
|
---|
248 | ckMST.enabled := false;
|
---|
249 | if Reason = 'R' then bbFile.caption := 'Remove';
|
---|
250 | end;
|
---|
251 | edProb.Caption := lblact.Caption;
|
---|
252 | if Piece(subjProb,U,3) <> '' then
|
---|
253 | edProb.Text := Piece(subjProb, u, 2) + ' (' + Piece(subjProb, u, 3) + ')'
|
---|
254 | else
|
---|
255 | edProb.Text := Piece(subjProb, u, 2);
|
---|
256 | {line up problem action and title}
|
---|
257 | {edProb.Left:=lblAct.left+lblAct.width+2;}
|
---|
258 | {get problem}
|
---|
259 | if Reason <> 'A' then
|
---|
260 | begin {edit,remove or display existing problem}
|
---|
261 | problemIFN := Piece(subjProb, u, 1);
|
---|
262 | //AList.Assign(EditLoad(ProblemIFN,pProviderID,PLPt.ptVAMC)) ;
|
---|
263 | AList.Assign(EditLoad(ProblemIFN,User.DUZ,PLPt.ptVAMC)) ; //V17.5 RV
|
---|
264 | end
|
---|
265 | else {new problem}
|
---|
266 | SetDefaultProb(Alist, subjProb);
|
---|
267 | if Alist.count = 0 then
|
---|
268 | begin
|
---|
269 | InfoBox('No Data on Host for problem ' + ProblemIFN, 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
270 | close;
|
---|
271 | exit;
|
---|
272 | end;
|
---|
273 | ProbRec := TProbRec.Create(Alist); {create a problem object}
|
---|
274 | ProbRec.PIFN := ProblemIFN;
|
---|
275 | ProbRec.EnteredBy.DHCPtoKeyVal(inttostr(User.DUZ) + u + User.Name);
|
---|
276 | ProbRec.RecordedBy.DHCPtoKeyVal(inttostr(Encounter.Provider) + u + Encounter.ProviderName);
|
---|
277 | {fill in defaults}
|
---|
278 | edOnsetdate.text := ProbRec.DateOnsetStr;
|
---|
279 | if Probrec.status <> 'A' then
|
---|
280 | begin
|
---|
281 | rgStatus.itemindex := 1;
|
---|
282 | rgStage.Visible := False ;
|
---|
283 | end;
|
---|
284 | if Probrec.Priority = 'A' then
|
---|
285 | rgStage.itemindex := 0
|
---|
286 | else if Probrec.Priority = 'C' then
|
---|
287 | rgStage.itemindex := 1
|
---|
288 | else
|
---|
289 | rgStage.itemindex := 2;
|
---|
290 | rgStatus.TabStop := (rgStatus.ItemIndex = -1);
|
---|
291 | rgStage.TabStop := (rgStage.ItemIndex = -1);
|
---|
292 | edRecDate.text := Probrec.DateRecStr;
|
---|
293 | edUpdate.text := Probrec.DateModStr;
|
---|
294 | edResDate.text := ProbRec.DateResStr;
|
---|
295 | edUpdate.enabled := false;
|
---|
296 | if pos(Reason,'CR') = 0 then
|
---|
297 | with PLPt do
|
---|
298 | begin
|
---|
299 | if UpperCase(Reason) = 'E' then
|
---|
300 | begin
|
---|
301 | ckSC.Enabled := ProbRec.SCProblem or PtServiceConnected;
|
---|
302 | ckSC.checked := ProbRec.SCProblem;
|
---|
303 | end
|
---|
304 | else
|
---|
305 | begin
|
---|
306 | ckSC.enabled := PtServiceConnected ;
|
---|
307 | ckSC.checked := ProbRec.SCProblem and PtServiceConnected ;
|
---|
308 | end;
|
---|
309 | ckAO.enabled := PtAgentOrange ;
|
---|
310 | ckRAD.enabled := PtRadiation ;
|
---|
311 | ckENV.enabled := PtEnvironmental ;
|
---|
312 | ckHNC.enabled := PtHNC ;
|
---|
313 | ckMST.enabled := PtMST ;
|
---|
314 | ckAO.checked := Probrec.AOProblem and PtAgentOrange;
|
---|
315 | ckRAD.checked := Probrec.RADProblem and PtRadiation;
|
---|
316 | ckENV.checked := Probrec.ENVProblem and PtEnvironmental;
|
---|
317 | ckHNC.checked := Probrec.HNCProblem and PtHNC;
|
---|
318 | ckMST.checked := Probrec.MSTProblem and PtMST;
|
---|
319 | end ;
|
---|
320 | cbProv.InitLongList(ProbRec.RespProvider.extern) ;
|
---|
321 | if (ProbRec.RespProvider.intern <> '') and (StrToInt64Def(ProbRec.RespProvider.intern, 0) > 0) then
|
---|
322 | cbProv.SelectByIEN(StrToInt64(ProbRec.RespProvider.intern)) ;
|
---|
323 |
|
---|
324 | if UpperCase(Reason) = 'A' then
|
---|
325 | begin
|
---|
326 | if Encounter.Inpatient then
|
---|
327 | begin
|
---|
328 | cbLoc.visible:=false;
|
---|
329 | cbServ.Visible:=true;
|
---|
330 | lblLoc.caption:='Service:';
|
---|
331 | cbServ.InitLongList('');
|
---|
332 | end
|
---|
333 | else
|
---|
334 | begin
|
---|
335 | cbLoc.visible:=true;
|
---|
336 | cbServ.Visible:=false;
|
---|
337 | lblLoc.caption:='Clinic:';
|
---|
338 | cbLoc.InitLongList(Encounter.LocationName) ;
|
---|
339 | cbLoc.SelectByIEN(Encounter.Location);
|
---|
340 | end;
|
---|
341 | end
|
---|
342 | else
|
---|
343 | begin
|
---|
344 | if (ProbRec.Service.DHCPField = '^') and (ProbRec.Clinic.DHCPField <> '^') then
|
---|
345 | begin
|
---|
346 | cbLoc.visible:=true;
|
---|
347 | cbServ.Visible:=false;
|
---|
348 | lblLoc.caption:='Clinic:';
|
---|
349 | cbLoc.InitLongList(ProbRec.Clinic.Extern) ;
|
---|
350 | cbLoc.SelectByID(ProbRec.Clinic.Intern) ;
|
---|
351 | end
|
---|
352 | else if (ProbRec.Clinic.DHCPField = '^') and (ProbRec.Service.DHCPField <> '^') then
|
---|
353 | begin
|
---|
354 | cbLoc.visible:=false;
|
---|
355 | cbServ.Visible:=true;
|
---|
356 | lblLoc.caption:='Service:';
|
---|
357 | cbServ.InitLongList(ProbRec.Service.Extern) ;
|
---|
358 | cbServ.SelectByID(ProbRec.Service.Intern) ;
|
---|
359 | end
|
---|
360 | else
|
---|
361 | begin
|
---|
362 | if Encounter.Inpatient then
|
---|
363 | begin
|
---|
364 | cbLoc.visible:=false;
|
---|
365 | cbServ.Visible:=true;
|
---|
366 | lblLoc.caption:='Service:';
|
---|
367 | cbServ.InitLongList('');
|
---|
368 | end
|
---|
369 | else
|
---|
370 | begin
|
---|
371 | cbLoc.visible:=true;
|
---|
372 | cbServ.Visible:=false;
|
---|
373 | lblLoc.caption:='Clinic:';
|
---|
374 | cbLoc.InitLongList('') ;
|
---|
375 | end;
|
---|
376 | end;
|
---|
377 | end;
|
---|
378 | cbLoc.Caption := lblLoc.Caption;
|
---|
379 |
|
---|
380 | if Pos(Reason,'E,C') > 0 then ShowComments ;
|
---|
381 | if ProbRec.CmtIsXHTML then
|
---|
382 | begin
|
---|
383 | bbAdd.Enabled := FALSE;
|
---|
384 | bbEdit.Enabled := FALSE;
|
---|
385 | bbRemove.Enabled := FALSE;
|
---|
386 | pnlComments.Hint := ProbRec.CmtNoEditReason;
|
---|
387 | end
|
---|
388 | else
|
---|
389 | begin
|
---|
390 | bbAdd.Enabled := TRUE;
|
---|
391 | bbEdit.Enabled := TRUE;
|
---|
392 | bbRemove.Enabled := TRUE;
|
---|
393 | pnlComments.Hint := '';
|
---|
394 | end ;
|
---|
395 | // =================== changed code - REV 7/30/98 =========================
|
---|
396 | // PlUser.usVerifyTranscribed is a SITE requirement, not a user ability
|
---|
397 | if Reason = 'A' then
|
---|
398 | begin
|
---|
399 | if PlUser.usVerifyTranscribed and not PlUser.usPrimeUser then
|
---|
400 | ckVerify.Checked := False
|
---|
401 | else
|
---|
402 | ckVerify.Checked := True;
|
---|
403 | end
|
---|
404 | else ckVerify.checked := (Probrec.condition = 'P');
|
---|
405 | //===========================================================================
|
---|
406 | (* if (PlUSer.usVerifyTranscribed) and (Reason='A') then
|
---|
407 | begin {some users can add and verify}
|
---|
408 | {ckVerify.visible:=true;}
|
---|
409 | ckVerify.checked:=true; {assume it will be entered verified}
|
---|
410 | end {others can add and edit verified status}
|
---|
411 | else if (PlUSer.usVerifyTranscribed) and (PlUser.usPrimeUser) then
|
---|
412 | begin
|
---|
413 | {ckVerify.visible:=true; }
|
---|
414 | ckVerify.checked:=(Probrec.condition='P');
|
---|
415 | end; *)
|
---|
416 | if Reason <> 'A' then fChanged := False else fChanged := True; {initialize form for changes}
|
---|
417 | finally
|
---|
418 | alist.free;
|
---|
419 | end;
|
---|
420 | end;
|
---|
421 |
|
---|
422 | procedure TfrmdlgProb.ShowComments;
|
---|
423 | var
|
---|
424 | i:integer;
|
---|
425 | begin
|
---|
426 | with ProbRec do
|
---|
427 | for i:=0 to Pred(fComments.count) do
|
---|
428 | lstComments.Items.Add(TComment(fComments[i]).ExtDateAdd + '^' + TComment(fComments[i]).Narrative);
|
---|
429 | end;
|
---|
430 |
|
---|
431 |
|
---|
432 | procedure TfrmdlgProb.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
433 | var
|
---|
434 | Alist: TStringList;
|
---|
435 | begin
|
---|
436 | AList := TStringList.Create;
|
---|
437 | try
|
---|
438 | //frmProblems.lblProbList.caption := frmProblems.pnlRight.Caption ; {moved to bbQuit - only on CANCEL}
|
---|
439 | TWinControl(parent).visible := false;
|
---|
440 | with frmProblems do
|
---|
441 | begin
|
---|
442 | pnlProbList.Visible := False ;
|
---|
443 | edProbEnt.text := '';
|
---|
444 | pnlView.BringToFront ;
|
---|
445 | pnlView.Show ;
|
---|
446 | mnuView.Enabled := True;
|
---|
447 | mnuAct.Enabled := True ;
|
---|
448 | lstView.Enabled := True ;
|
---|
449 | bbNewProb.Enabled := true ;
|
---|
450 | if fChanged then LoadPatientProblems(AList,PLUser.usViewAct[1],false);
|
---|
451 | end ;
|
---|
452 | Action := caFree;
|
---|
453 | finally
|
---|
454 | AList.Free;
|
---|
455 | end;
|
---|
456 | end;
|
---|
457 |
|
---|
458 | {--------------------------------- file ---------------------------------}
|
---|
459 |
|
---|
460 | procedure TfrmdlgProb.bbFileClick(Sender: TObject);
|
---|
461 | const
|
---|
462 | TX_INACTIVE_CODE = 'This problem references an inactive ICD code.' + #13#10 +
|
---|
463 | 'The code must be updated using the ''Change''' + #13#10 +
|
---|
464 | 'button before it can be saved';
|
---|
465 | TC_INACTIVE_CODE = 'Inactive Code';
|
---|
466 | var
|
---|
467 | AList: TstringList;
|
---|
468 | remcom, vu, ut: string;
|
---|
469 | i: integer;
|
---|
470 | begin
|
---|
471 | if (Reason <> 'R') and (Reason <> 'r') then
|
---|
472 | if (rgStatus.itemindex=-1) or (cbProv.itemindex=-1) then
|
---|
473 | begin
|
---|
474 | InfoBox('Status and Responsible Provider are required.', 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
475 | exit;
|
---|
476 | end;
|
---|
477 | if Reason in ['C','c','E','e'] then
|
---|
478 | if not IsActiveICDCode(ProbRec.Diagnosis.extern) then
|
---|
479 | begin
|
---|
480 | InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
|
---|
481 | exit;
|
---|
482 | end;
|
---|
483 | if BadDates then exit;
|
---|
484 | Alist:=TStringList.create;
|
---|
485 | try
|
---|
486 | screen.cursor := crHourGlass;
|
---|
487 | {if (ckVerify.visible) then }
|
---|
488 | if (ckVerify.Checked) then
|
---|
489 | ProbRec.Condition := 'P'
|
---|
490 | else
|
---|
491 | Probrec.Condition := 'T';
|
---|
492 | if rgStatus.itemindex = 0 then
|
---|
493 | Probrec.status := 'A'
|
---|
494 | else if rgstatus.itemindex = 1 then
|
---|
495 | Probrec.status := 'I';
|
---|
496 | if rgStage.itemindex = 0 then
|
---|
497 | Probrec.Priority := 'A'
|
---|
498 | else if rgStage.itemindex = 1 then
|
---|
499 | Probrec.Priority := 'C';
|
---|
500 | ProbRec.DateOnsetStr := edOnsetDate.text;
|
---|
501 | ProbRec.DateResStr := edResDate.text;{aka inactivation date}
|
---|
502 | ProbRec.DateRecStr := edRecDate.text;{recorded anywhere}
|
---|
503 | if edUpdate.text = '' then
|
---|
504 | ProbRec.DateModStr := DatetoStr(trunc(FMNow))
|
---|
505 | else
|
---|
506 | ProbRec.DateModStr := edUpdate.text; {last update}
|
---|
507 | (*if ckSC.enabled then *)Probrec.SCProblem := ckSC.checked;
|
---|
508 | if ckRAD.enabled then Probrec.RadProblem := ckrad.Checked;
|
---|
509 | if ckAO.enabled then ProbRec.AOProblem := ckAO.checked;
|
---|
510 | if ckENV.enabled then ProbRec.ENVProblem := ckENV.Checked;
|
---|
511 | if ckHNC.enabled then ProbRec.HNCProblem := ckHNC.Checked;
|
---|
512 | if ckMST.enabled then ProbRec.MSTProblem := ckMST.Checked;
|
---|
513 | if cbProv.itemindex = -1 then {Get provider}
|
---|
514 | begin
|
---|
515 | Probrec.respProvider.intern := '0';
|
---|
516 | Probrec.RespProvider.extern := '';
|
---|
517 | end
|
---|
518 | else
|
---|
519 | ProbRec.RespProvider.DHCPtoKeyVal(cbProv.Items[cbProv.itemindex]);
|
---|
520 | if cbLoc.itemindex = -1 then {Get Clinic}
|
---|
521 | begin
|
---|
522 | Probrec.Clinic.intern := '';
|
---|
523 | Probrec.Clinic.extern := '';
|
---|
524 | end
|
---|
525 | else
|
---|
526 | ProbRec.Clinic.DHCPtoKeyVal(cbLoc.Items[cbLoc.itemindex]);
|
---|
527 | if cbServ.itemindex = -1 then {Get Service}
|
---|
528 | begin
|
---|
529 | Probrec.Service.intern := '';
|
---|
530 | Probrec.Service.extern := '';
|
---|
531 | end
|
---|
532 | else
|
---|
533 | Probrec.Service.DHCPtoKeyVal(cbServ.Items[cbServ.itemindex]);
|
---|
534 | if ProbRec.Commentcount > 0 then GetEditedComments;
|
---|
535 | GetNewComments(Reason);
|
---|
536 | case Reason of
|
---|
537 | 'E','e','C','c': {edits or comments}
|
---|
538 | begin
|
---|
539 | ut := '';
|
---|
540 | if PLUser.usPrimeUser then ut := '1';
|
---|
541 | //AList.Assign(EditSave(ProblemIFN,pProviderID,PLPt.ptVAMC,ut,ProbRec.FilerObject)) ;
|
---|
542 | AList.Assign(EditSave(ProblemIFN,User.DUZ,PLPt.ptVAMC,ut,ProbRec.FilerObject)) ; //V17.5 RV
|
---|
543 | end;
|
---|
544 | 'A','a': {new problem}
|
---|
545 | AList.Assign(AddSave(PLPt.GetGMPDFN(Patient.DFN, Patient.Name),
|
---|
546 | pProviderID,PLPt.ptVAMC,ProbRec.FilerObject)) ; //*DFN*
|
---|
547 | 'R','r': {remove problem}
|
---|
548 | begin
|
---|
549 | remcom := '';
|
---|
550 | if Probrec.commentcount > 0 then
|
---|
551 | if TComment(Probrec.comments[pred(probrec.commentcount)]).IsNew then
|
---|
552 | remcom := TComment(Probrec.comments[pred(probrec.commentcount)]).Narrative;
|
---|
553 | AList.Assign(ProblemDelete(ProbRec.PIFN,User.DUZ,PLPt.ptVAMC,remcom)) ; //changed in v14
|
---|
554 | //AList.Assign(ProblemDelete(ProbRec.PIFN,Encounter.Provider,PLPt.ptVAMC,remcom)) ;
|
---|
555 | end
|
---|
556 | else exit;
|
---|
557 | end; {case}
|
---|
558 | screen.cursor := crDefault;
|
---|
559 | if Alist.count < 1 then
|
---|
560 | InfoBox('Broker time out filing on Host. Try again in a moment or cancel', 'Information', MB_OK or MB_ICONINFORMATION)
|
---|
561 | else if Alist[0] = '1' then
|
---|
562 | begin
|
---|
563 | Alist.clear;
|
---|
564 | vu:=PLUser.usViewAct;
|
---|
565 | fChanged := True; {ensure update of problem list on close}
|
---|
566 | //frmProblems.LoadPatientProblems(AList,vu[1],false);
|
---|
567 | { update cover sheet problem list }
|
---|
568 | with frmCover do
|
---|
569 | for i := ComponentCount - 1 downto 0 do
|
---|
570 | begin
|
---|
571 | if Components[i] is TORListBox then
|
---|
572 | begin
|
---|
573 | case Components[i].Tag of
|
---|
574 | 10: ListActiveProblems((Components[i] as TORListBox).Items);
|
---|
575 | end;
|
---|
576 | end;
|
---|
577 | end;
|
---|
578 | Close;
|
---|
579 | end
|
---|
580 | else
|
---|
581 | InfoBox('Unable to lock record for filing on Host. Try again in a moment or cancel',
|
---|
582 | 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
583 | finally
|
---|
584 | Alist.free
|
---|
585 | end;
|
---|
586 | end;
|
---|
587 |
|
---|
588 | procedure TfrmdlgProb.GetEditedComments;
|
---|
589 | var
|
---|
590 | i: integer;
|
---|
591 | begin
|
---|
592 | for i := 0 to pred(ProbRec.CommentCount) do
|
---|
593 | if i < lstComments.Items.Count then with lstComments do
|
---|
594 | begin
|
---|
595 | if Items[i] = 'DELETED' then
|
---|
596 | TComment(ProbRec.fComments[i]).Narrative := '' {this deletes the comment}
|
---|
597 | else
|
---|
598 | begin
|
---|
599 | TComment(ProbRec.fComments[i]).DateAdd := Piece(lstComments.Items[i], U, 1) ;
|
---|
600 | TComment(ProbRec.fComments[i]).Narrative := Piece(lstComments.Items[i], U, 2) ;
|
---|
601 | end;
|
---|
602 | end;
|
---|
603 | end;
|
---|
604 |
|
---|
605 | procedure TfrmdlgProb.GetNewComments(Reason: char);
|
---|
606 | var
|
---|
607 | i, start: integer;
|
---|
608 | begin
|
---|
609 | {don't display previous comments for add comment or remove problem functions}
|
---|
610 | if (Reason <> 'R') then
|
---|
611 | start := ProbRec.CommentCount
|
---|
612 | else
|
---|
613 | start := 0;
|
---|
614 | for i := start to Pred(lstComments.Items.Count) do
|
---|
615 | begin
|
---|
616 | with lstComments do
|
---|
617 | begin
|
---|
618 | if (lstComments.Items[i] <> 'DELETED') and (Piece(lstComments.Items[i], u, 2) <> '') then
|
---|
619 | ProbRec.AddNewComment(Piece(lstComments.Items[i],u,2));
|
---|
620 | end;
|
---|
621 | end;
|
---|
622 | end;
|
---|
623 |
|
---|
624 | procedure TfrmdlgProb.bbRemoveClick(Sender: TObject);
|
---|
625 | begin
|
---|
626 | if (lstComments.Items.Count = 0) or (lstComments.ItemIndex < 0) then exit ;
|
---|
627 | lstComments.Items[lstComments.ItemIndex] := 'DELETED' ;
|
---|
628 | fChanged := true;
|
---|
629 | end;
|
---|
630 |
|
---|
631 | procedure TfrmdlgProb.cbProvKeyPress(Sender: TObject; var Key: Char);
|
---|
632 | begin
|
---|
633 | if key = #13 then
|
---|
634 | SendMessage(cbProv.Handle, CB_SHOWDROPDOWN, 1, 0) {Opens list}
|
---|
635 | else
|
---|
636 | SendMessage(cbProv.Handle, CB_SHOWDROPDOWN, 0, 0) {Closes list}
|
---|
637 | end;
|
---|
638 |
|
---|
639 | procedure TfrmdlgProb.rgStatusClick(Sender: TObject);
|
---|
640 | begin
|
---|
641 | if rgStatus.Itemindex = 1 then
|
---|
642 | begin
|
---|
643 | edResDate.text := DateToStr(Date) ;
|
---|
644 | rgStage.Visible := False ;
|
---|
645 | end
|
---|
646 | else
|
---|
647 | begin
|
---|
648 | edResDate.text := '';
|
---|
649 | rgStage.Visible := True ;
|
---|
650 | end ;
|
---|
651 | FChanged := True;
|
---|
652 | end;
|
---|
653 |
|
---|
654 | procedure TfrmdlgProb.cbProvClick(Sender: TObject);
|
---|
655 | begin
|
---|
656 | SendMessage(cbProv.Handle, CB_SHOWDROPDOWN, 0, 0); {Closes list}
|
---|
657 | end;
|
---|
658 |
|
---|
659 | procedure TfrmdlgProb.cbLocClick(Sender: TObject);
|
---|
660 | begin
|
---|
661 | SendMessage(cbLoc.Handle, CB_SHOWDROPDOWN, 0, 0); {Closes list}
|
---|
662 | end;
|
---|
663 |
|
---|
664 | procedure TfrmdlgProb.cbLocKeyPress(Sender: TObject; var Key: Char);
|
---|
665 | begin
|
---|
666 | if key = #13 then
|
---|
667 | SendMessage(cbLoc.Handle, CB_SHOWDROPDOWN, 1, 0) {Opens list}
|
---|
668 | else
|
---|
669 | SendMessage(cbLoc.Handle, CB_SHOWDROPDOWN, 0, 0) {Closes list}
|
---|
670 | end;
|
---|
671 |
|
---|
672 |
|
---|
673 | procedure TfrmdlgProb.SetDefaultProb(Alist: TStringList; prob: string);
|
---|
674 | var
|
---|
675 | Today: string;
|
---|
676 |
|
---|
677 | function Permanent: char;
|
---|
678 | begin
|
---|
679 | // =================== changed code - REV 7/30/98 =========================
|
---|
680 | // PlUser.usVerifyTranscribed is a SITE requirement, not a USER ability
|
---|
681 | if PlUser.usVerifyTranscribed and not PlUser.usPrimeUser then
|
---|
682 | result:='T'
|
---|
683 | else
|
---|
684 | result:='P';
|
---|
685 | //===========================================================================
|
---|
686 | { if PLUser.usPrimeUser or (PlUser.usVerifyTranscribed) then
|
---|
687 | result:='P'
|
---|
688 | else
|
---|
689 | result:='T';}
|
---|
690 | end;
|
---|
691 |
|
---|
692 | begin {BODY }
|
---|
693 | Today := PLPt.Today;
|
---|
694 | if Piece(prob, u, 4) <> '' then
|
---|
695 | alist.add('NEW' + v + '.01' + v +Piece(prob, u, 4) + u + Piece(prob, u, 3))
|
---|
696 | else
|
---|
697 | alist.add('NEW' + v + '.01' + v + u); {no icd code}
|
---|
698 | {Leave ien of .05 undefined - let host save routine compute it}
|
---|
699 | alist.add('NEW' + v + '.05' + v + u + Piece(prob,u,2));{actual text}
|
---|
700 | alist.add('NEW' + v + '.06' + v + PLPt.PtVAMC);
|
---|
701 | alist.add('NEW' + v + '.08' + v + Today);
|
---|
702 | alist.add('NEW' + v + '.12' + v + 'A' + u + 'ACTIVE');
|
---|
703 | alist.add('NEW' + v + '.13' + v + '');
|
---|
704 | alist.add('NEW' + v + '1.01' + v + Piece(prob,u,1) + u + Piece(prob,u,2));{standardized text}
|
---|
705 | alist.add('NEW' + v + '1.02' + v + Permanent); {Permanent or Transcribed status}
|
---|
706 | alist.add('NEW' + v + '1.03' + v + inttostr(Encounter.Provider) + u + Encounter.Providername); {ent by}
|
---|
707 | alist.add('NEW' + v + '1.04' + v + inttostr(Encounter.Provider) + u + Encounter.Providername); {recording prov}
|
---|
708 | alist.add('NEW' + v + '1.05' + v + inttostr(Encounter.Provider) + u + Encounter.Providername); {resp prov}
|
---|
709 | alist.add('NEW' + v + '1.06' + v + PLUser.usService); {user's service/section}
|
---|
710 | alist.add('NEW' + v + '1.07' + v + '');
|
---|
711 | alist.add('NEW' + v + '1.08' + v + '') ;{IntToStr(Encounter.Location));}
|
---|
712 | alist.add('NEW' + v + '1.09' + v + Today);
|
---|
713 | alist.add('NEW' + v + '1.1' + v + '0' + u + 'NO'); {SC}
|
---|
714 | alist.add('NEW' + v + '1.11' + v + '0' + u + 'NO'); {AO}
|
---|
715 | alist.add('NEW' + v + '1.12' + v + '0' + u + 'NO'); {RAD}
|
---|
716 | alist.add('NEW' + v + '1.13' + v + '0' + u + 'NO'); {ENV}
|
---|
717 | alist.add('NEW' + v + '1.14' + v + '');
|
---|
718 | end;
|
---|
719 |
|
---|
720 |
|
---|
721 | function TfrmdlgProb.BadDates:Boolean;
|
---|
722 | var
|
---|
723 | ds:string;
|
---|
724 | i:integer;
|
---|
725 |
|
---|
726 | procedure Msg(msg: string);
|
---|
727 | begin
|
---|
728 | InfoBox('Dates must be in format m/d/y or m/d or y, or T+d or T-d' +
|
---|
729 | #13#10 + msg + ' is formatted improperly.' +
|
---|
730 | #13#10 + ' Please check the other dates as well.',
|
---|
731 | 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
732 | end;
|
---|
733 | begin
|
---|
734 | result:=True; {initialize for error condition}
|
---|
735 | if edRecDate.text <>'' then
|
---|
736 | begin
|
---|
737 | ds:=DateStringOk(edRecDate.text);
|
---|
738 | if ds = 'ERROR' then
|
---|
739 | begin
|
---|
740 | msg('Recorded');
|
---|
741 | exit;
|
---|
742 | end;
|
---|
743 | end ;
|
---|
744 | if edResDate.text <>'' then
|
---|
745 | begin
|
---|
746 | ds:=DateStringOk(edResDate.text);
|
---|
747 | if ds = 'ERROR' then
|
---|
748 | begin
|
---|
749 | msg('Resolved');
|
---|
750 | exit;
|
---|
751 | end;
|
---|
752 | end ;
|
---|
753 | if edOnsetDate.text <>'' then
|
---|
754 | begin
|
---|
755 | ds:=DateStringOk(edOnsetDate.text);
|
---|
756 | if ds = 'ERROR' then
|
---|
757 | begin
|
---|
758 | msg('Onset');
|
---|
759 | exit;
|
---|
760 | end;
|
---|
761 | if StrToFMDateTime(edOnsetDate.Text) > FMNow then
|
---|
762 | begin
|
---|
763 | InfoBox('Onset dates in the future are not allowed.', 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
764 | Exit;
|
---|
765 | end;
|
---|
766 | end ;
|
---|
767 | for i:=0 to pred(lstComments.Items.Count) do
|
---|
768 | begin
|
---|
769 | if Piece(lstComments.Items[i],u,2)<>'' then {may have blank lines at bottom}
|
---|
770 | begin
|
---|
771 | ds:=DateStringOk(Piece(lstComments.Items[i],u,1));
|
---|
772 | if ds='ERROR' then
|
---|
773 | begin
|
---|
774 | msg('Comment #' + inttostr(i));
|
---|
775 | exit;
|
---|
776 | end;
|
---|
777 | end;
|
---|
778 | end;
|
---|
779 | result:=False; {made it through, so no bad dates}
|
---|
780 | end;
|
---|
781 |
|
---|
782 | procedure TfrmdlgProb.ControlChange(Sender: TObject);
|
---|
783 | begin
|
---|
784 | fChanged:=true;
|
---|
785 | end;
|
---|
786 |
|
---|
787 | destructor TfrmdlgProb.Destroy;
|
---|
788 | begin
|
---|
789 | ProbRec.free;
|
---|
790 | ProbRec := nil;
|
---|
791 | FCtrlMap.Free;
|
---|
792 | if fprobs.dlgProbs <> nil then fprobs.dlgProbs := nil;
|
---|
793 | if (not Application.Terminated) and (not uInit.TimedOut) then {prevents GPF if system close box is clicked
|
---|
794 | while frmDlgProbs is visible}
|
---|
795 | if Assigned(frmProblems) then PostMessage(frmProblems.Handle, UM_CLOSEPROBLEM, 0, 0);
|
---|
796 | inherited Destroy ;
|
---|
797 | end;
|
---|
798 |
|
---|
799 | procedure TfrmdlgProb.cbProvDropDown(Sender: TObject);
|
---|
800 | var
|
---|
801 | alist:TstringList;
|
---|
802 | i:integer;
|
---|
803 | v:string;
|
---|
804 | begin
|
---|
805 | v := uppercase(cbProv.text);
|
---|
806 | if (v <> '') then
|
---|
807 | begin
|
---|
808 | alist := TstringList.create;
|
---|
809 | try
|
---|
810 | AList.Assign(ProviderList('',25,V,V)) ;
|
---|
811 | if alist.count > 0 then
|
---|
812 | begin
|
---|
813 | if cbProv.items.count + 25 > 100 then
|
---|
814 | for i := 0 to 75 do {don't allow more than 100 to build up}
|
---|
815 | cbProv.Items.delete(i);
|
---|
816 | for i := 0 to pred(alist.count) do
|
---|
817 | cbProv.Items.add(Alist[i]); {add new ones to list}
|
---|
818 | end;
|
---|
819 | finally
|
---|
820 | alist.free;
|
---|
821 | end;
|
---|
822 | end;
|
---|
823 | end;
|
---|
824 |
|
---|
825 | procedure TfrmdlgProb.cbLocDropDown(Sender: TObject);
|
---|
826 | var
|
---|
827 | alist: TstringList;
|
---|
828 | v: string;
|
---|
829 | begin
|
---|
830 | v := uppercase(cbLoc.text);
|
---|
831 | alist := TstringList.create;
|
---|
832 | try
|
---|
833 | AList.Assign(ClinicSearch(' ')) ;
|
---|
834 | if alist.count > 0 then cbLoc.Items.assign(Alist);
|
---|
835 | finally
|
---|
836 | alist.free;
|
---|
837 | end;
|
---|
838 | end;
|
---|
839 |
|
---|
840 | procedure TfrmdlgProb.FormCreate(Sender: TObject);
|
---|
841 | begin
|
---|
842 | FSilent := False;
|
---|
843 | if rgStatus.ItemIndex = -1
|
---|
844 | then
|
---|
845 | InitialFocus := rgStatus
|
---|
846 | else
|
---|
847 | InitialFocus := rgStatus.Controls[rgStatus.ItemIndex] as TWinControl;
|
---|
848 | end;
|
---|
849 |
|
---|
850 | { old TPLDlgForm Methods }
|
---|
851 |
|
---|
852 | constructor TfrmdlgProb.Create(AOwner: TComponent);
|
---|
853 | { It is unusual to not call the inherited Create first, but necessary in this case; some
|
---|
854 | of the TMStruct objects need to be created before the form gets its OnCreate event. }
|
---|
855 | begin
|
---|
856 | FCtrlMap := TStringList.Create; { FCtrlMap[n]='CtrlName=PtrID' }
|
---|
857 | inherited Create(AOwner);
|
---|
858 | FInitialShow := True;
|
---|
859 | FModified := False;
|
---|
860 | FEditing := False;
|
---|
861 | end;
|
---|
862 |
|
---|
863 | procedure TfrmdlgProb.CreateParams(var Params: TCreateParams);
|
---|
864 | begin
|
---|
865 | inherited CreateParams(Params);
|
---|
866 | { to make the form a child window }
|
---|
867 | with Params do
|
---|
868 | begin
|
---|
869 | if Owner is TPanel then
|
---|
870 | WndParent := (Owner as TPanel).Handle
|
---|
871 | else {pdr}
|
---|
872 | WndParent := Application.MainForm.Handle;
|
---|
873 | Style := ws_Child or ws_ClipSiblings;
|
---|
874 | X := 0;
|
---|
875 | Y := 0;
|
---|
876 | end;
|
---|
877 | end;
|
---|
878 |
|
---|
879 | procedure TfrmdlgProb.Loaded;
|
---|
880 | begin
|
---|
881 | inherited Loaded;
|
---|
882 | { allow the form to be treated as a child form }
|
---|
883 | Visible := False;
|
---|
884 | Position := poDefault;
|
---|
885 | BorderIcons := [];
|
---|
886 | BorderStyle := bsNone;
|
---|
887 | HandleNeeded;
|
---|
888 | end;
|
---|
889 |
|
---|
890 | procedure TfrmdlgProb.DoShow;
|
---|
891 | begin
|
---|
892 | FInitialShow := False;
|
---|
893 | inherited DoShow;
|
---|
894 | end;
|
---|
895 |
|
---|
896 | procedure TfrmdlgProb.SetFontSize( NewFontSize: integer);
|
---|
897 | begin
|
---|
898 | ResizeAnchoredFormToFont( self );
|
---|
899 | end;
|
---|
900 |
|
---|
901 | { base form procedures (shared by all ordering dialogs) }
|
---|
902 |
|
---|
903 |
|
---|
904 | procedure TfrmdlgProb.ClearDialogControls; { Reset all the controls in the dialog }
|
---|
905 | var
|
---|
906 | i: Integer;
|
---|
907 | begin
|
---|
908 | for i := 0 to ControlCount - 1 do
|
---|
909 | begin
|
---|
910 | if Controls[i] is TLabel then Continue;
|
---|
911 | if Controls[i] is TButton then Continue;
|
---|
912 | end;
|
---|
913 | LoadDefaults; { added for lab to reset cleared lists }
|
---|
914 | end;
|
---|
915 |
|
---|
916 | procedure TfrmdlgProb.LoadDefaults;
|
---|
917 | begin
|
---|
918 | { by default nothing - should override in specific dialog }
|
---|
919 | end;
|
---|
920 |
|
---|
921 |
|
---|
922 |
|
---|
923 | function TfrmdlgProb.LackRequired: Boolean;
|
---|
924 | begin
|
---|
925 | Result := False; { should override to check for additional required fields }
|
---|
926 | end;
|
---|
927 |
|
---|
928 |
|
---|
929 | procedure TfrmdlgProb.UMTakeFocus(var Message: TMessage);
|
---|
930 | begin
|
---|
931 | if FInitialFocus = nil then exit; {PDR}
|
---|
932 | if (FInitialFocus.visible) and (FInitialFocus.enabled) then FInitialFocus.SetFocus;
|
---|
933 | end;
|
---|
934 |
|
---|
935 | procedure TfrmdlgProb.bbChangeProbClick(Sender: TObject);
|
---|
936 | const
|
---|
937 | TX799 = '799.9';
|
---|
938 | var
|
---|
939 | newprob: string ;
|
---|
940 | frmPLLex: TfrmPLLex;
|
---|
941 | begin
|
---|
942 | if PLUser.usUseLexicon then
|
---|
943 | begin
|
---|
944 | frmPLLex:=TfrmPLLex.create(Application);
|
---|
945 | try
|
---|
946 | frmPLLex.showmodal;
|
---|
947 | finally
|
---|
948 | frmPLLex.Free;
|
---|
949 | end;
|
---|
950 | end
|
---|
951 | else
|
---|
952 | begin
|
---|
953 | PLProblem := InputBox('Change problem','Enter new problem name: ','') ;
|
---|
954 | if PLProblem<>'' then
|
---|
955 | PLProblem := u + PLProblem + u + TX799 + u
|
---|
956 | else
|
---|
957 | exit ;
|
---|
958 | end ;
|
---|
959 |
|
---|
960 | {problems are in the form of: ien^.01^icd^icdifn , although only the .01 is required}
|
---|
961 | if PLProblem='' then exit ;
|
---|
962 | newprob := PLProblem ;
|
---|
963 | if frmProblems.HighlightDuplicate(NewProb, Piece(newprob, U, 2) + #13#10#13#10 +
|
---|
964 | 'This problem would be a duplicate.'+#13#10 +
|
---|
965 | 'Return to the list and see the highlighted problem.',
|
---|
966 | mtInformation, 'CHANGE') then
|
---|
967 | exit {bail out - don't want dups}
|
---|
968 | else
|
---|
969 | begin
|
---|
970 | {ien^.01^icd^icdifn - see SetDefaultProblem}
|
---|
971 | {Set new problem properties}
|
---|
972 | ProbRec.Problem.DHCPtoKeyVal(Piece(NewProb,u,1) + u + Piece(NewProb,u,2)) ; {1.01}
|
---|
973 | ProbRec.Diagnosis.DHCPtoKeyVal(Piece(NewProb,u,4) + u + Piece(NewProb,u,3)) ; {.01}
|
---|
974 | ProbRec.Narrative.DHCPtoKeyVal(u + Piece(NewProb,u,2)); {.05}
|
---|
975 |
|
---|
976 | {mark it as changed}
|
---|
977 | fchanged := true ;
|
---|
978 |
|
---|
979 | {Redraw heading}
|
---|
980 | if Piece(NewProb,u,3)<>'' then
|
---|
981 | edProb.Text:=Piece(NewProb,u,2) + ' (' + Piece(NewProb,u,3) + ')'
|
---|
982 | else
|
---|
983 | edProb.Text:=Piece(NewProb,u,2) + ' (799.9)'; {code not found, or free-text entry}
|
---|
984 | end ;
|
---|
985 | end ;
|
---|
986 |
|
---|
987 | procedure TfrmdlgProb.cbLocNeedData(Sender: TObject; const StartFrom: String;
|
---|
988 | Direction, InsertAt: Integer);
|
---|
989 | begin
|
---|
990 | cbLoc.ForDataUse(SubSetOfClinics(StartFrom, Direction));
|
---|
991 | end;
|
---|
992 |
|
---|
993 | procedure TfrmdlgProb.cbProvNeedData(Sender: TObject; const StartFrom: String;
|
---|
994 | Direction, InsertAt: Integer);
|
---|
995 | begin
|
---|
996 | cbProv.ForDataUse(SubSetOfProviders(StartFrom, Direction));
|
---|
997 | end;
|
---|
998 |
|
---|
999 | procedure TfrmdlgProb.cbServNeedData(Sender: TObject; const StartFrom: String;
|
---|
1000 | Direction, InsertAt: Integer);
|
---|
1001 | begin
|
---|
1002 | cbServ.ForDataUse(ServiceSearch(StartFrom, Direction));
|
---|
1003 | end;
|
---|
1004 |
|
---|
1005 | end.
|
---|