source: cprs/branches/foia-cprs/CPRS-Chart/BA/fBALocalDiagnoses.pas@ 1545

Last change on this file since 1545 was 460, checked in by Kevin Toppenberg, 17 years ago

Uploading from OR_30_258
File size: 48.1 KB
Line 
1unit fBALocalDiagnoses;
2 {.$define debug}
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls,fPCELex, uConsults, ORFn,
8 rPCE,DBCtrls, DB, DBClient, uPCE, fEncounterFrame, ComCtrls, Grids, UBAGlobals,
9 Buttons, Menus, UBACore, UCore;
10
11type
12 DxRecord = Record
13 DxFiller1 : string;
14 DxFiller2 : string;
15 DxAddToPL : string;
16 DxPrimary : string;
17 DxCode : string;
18 end;
19 TfrmBALocalDiagnoses = class(TfrmAutoSz)
20 pnlTop: TPanel;
21 lbOrders: TListBox;
22 pnlMain: TPanel;
23 lbSections: TORListBox;
24 pnlBottom: TORAutoPanel;
25 lvDxGrid: TListView;
26 cbAddToPDList: TCheckBox;
27 cbAddToPL: TCheckBox;
28 btnPrimary: TButton;
29 btnRemove: TButton;
30 btnSelectAll: TButton;
31 buOK: TButton;
32 buCancel: TButton;
33 btnOther: TButton;
34 lbDiagnosis: TORListBox;
35 ORStaticText1: TORStaticText;
36 ORStaticText2: TORStaticText;
37 ORStaticText3: TORStaticText;
38 ORStaticText4: TORStaticText;
39 lblPatientName: TStaticText;
40 procedure buOKClick(Sender: TObject);
41 procedure buCancelClick(Sender: TObject);
42 procedure FormCreate(Sender: TObject);
43 procedure Button4Click(Sender: TObject);
44 procedure lbSectionsClick(Sender: TObject);
45 procedure btnOtherClick(Sender: TObject);
46 procedure btnPrimaryClick(Sender: TObject);
47 procedure btnRemoveClick(Sender: TObject);
48 procedure btnSelectAllClick(Sender: TObject);
49 procedure cbAddToPLClick(Sender: TObject);
50 procedure ProcessAddToItems;
51 procedure lbDiagnosisClick(Sender: TObject);
52 procedure FormActivate(Sender: TObject);
53 procedure FormShow(Sender: TObject);
54 procedure AddDiagnosistoPersonalDiagnosesList1Click(Sender: TObject);
55 procedure AddDiagnosistoPersonalDiagnosesList2Click(Sender: TObject);
56
57 procedure cbAddToPDListClick(Sender: TObject);
58 procedure lbSectionsDrawItem(Control: TWinControl; Index: Integer;
59 Rect: TRect; State: TOwnerDrawState);
60 procedure lvDxGridKeyDown(Sender: TObject; var Key: Word;
61 Shift: TShiftState);
62 procedure lvDxGridKeyUp(Sender: TObject; var Key: Word;
63 Shift: TShiftState);
64 procedure lvDxGridClick(Sender: TObject);
65 procedure lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X,
66 Y: Integer);
67 procedure ORStaticText1Enter(Sender: TObject);
68 procedure ORStaticText1Exit(Sender: TObject);
69 procedure ORStaticText3Enter(Sender: TObject);
70 procedure ORStaticText3Exit(Sender: TObject);
71
72 private
73 { Private declarations }
74
75
76 inactiveCodes: integer;
77 procedure MainDriver;
78 procedure LoadEncounterForm;
79 procedure AddProbsToDiagnosis;
80 procedure AddPCEToDiagnosis;//** adds dx's if selected currently from ecf
81 procedure AddPersonalDxToDiagnosisList;
82 procedure ListDiagnosisSections(Dest: TStrings);
83 procedure ListDiagnosisCodes(Section : String);
84 procedure DiagnosisSelection(SelectedDx: String);
85 procedure EnsurePrimary;
86 function IsDxAlreadySelected(SelectedDx: string):boolean;
87 procedure BuildTempDxList;
88 procedure AssocDxToOrders;
89 procedure BuildBADxList;
90 procedure ListGlobalDx(pOrderIDList: TStringList);
91 procedure ListConsultDX(pOrderDxList: TStringList);
92 procedure DeselectGridItems;
93 procedure ListSelectedOrders;
94 procedure BuildConsultDxList(pDxList: TStringList);
95 function AddToWhatList(IsPLChecked:boolean; IsPDLChecked:boolean):string;
96 procedure AddToProblemList;
97 procedure AddToPersonalDxList;
98 procedure InactiveICDNotification;
99 procedure LoadTempDXLists;
100 procedure SetAddToCBoxStatus;
101 procedure SetAddToCheckBoxStatus(ADiagnosis:string);
102 procedure ClearAndDisableCBoxes;
103 procedure ProcessMultSelections;
104 function ProblemListDxFound(pDxCode:string):boolean;
105 function PersonalListDxFound(pDxCode:string):boolean;
106 procedure ReSetCheckBoxStatus(pDxCode:String);
107
108 public
109 FLastHintItemNum: integer;
110 procedure Enter(theCaller: smallint; pOrderIDList: TStringList);
111 procedure LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string);
112 end;
113
114 const
115 TX799 = '799.9';
116 PROBLEM_LIST_SECTION = 'Problem List Items';
117 PERSONAL_DX_SECTION = 'Personal Diagnoses List Items';
118
119var
120 deleteDX: boolean;
121 selectingDX: boolean;
122 FDxCode: string;
123 FDxSection: string;
124 PList: TextFile;
125 FName: string;
126 MaxDx : Integer;
127 GridItems: integer;
128 UpdatingGrid: boolean;
129 whoCalled: smallint;
130 currentOrderIDList: TStringList;
131 ProblemDxHoldList, PersonalDxHoldList: TStringList;
132 frmBALocalDiagnoses: TfrmBALocalDiagnoses;
133 lexIENHoldList: TStringList; //** OrderID^Lexicon IEN
134
135
136implementation
137
138uses rCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
139 uAccessibleStringGrid,ORNet, fProbs, fOrdersSign, UBAConst,
140 UBAMessages, fReview, uSignItems, fODConsult, fFrame;
141
142var
143 uProblems : TStringList;
144 BADiagnosis : TStringList;
145 ECFDiagnosis : TStringList;
146 uLastDFN : string;
147 uLastLocation: integer;
148 ListItem : TListItem;
149 uPrimaryDxHold: string;
150 PrimaryChanged: boolean;
151{$R *.dfm}
152
153//************* Entry point *****************//
154
155procedure TfrmBALocalDiagnoses.Enter(theCaller:smallint; pOrderIDList: TStringList);
156begin
157 selectingDX := False;
158 deleteDX := False;
159 fBALocalDiagnoses.whoCalled := theCaller;
160 currentOrderIDList := pOrderIDList;
161 frmBALocalDiagnoses := TfrmBALocalDiagnoses.Create(Application);
162 ResizeFormToFont(TForm(frmBALocalDiagnoses));
163 frmBALocalDiagnoses.ShowModal;
164 frmBALocalDiagnoses.Release;
165
166end;
167procedure TfrmBALocalDiagnoses.FormCreate(Sender: TObject);
168begin
169 MaxDx := 4;
170 inactiveCodes := 0;
171 MainDriver;
172 GridItems := 0;
173 PrimaryChanged := False;
174 FLastHintItemNum := -1;
175 ClearAndDisableCBoxes
176end;
177
178procedure TfrmBALocalDiagnoses.ListDiagnosisSections(Dest: TStrings);
179{ return section names in format: ListIndex^SectionName (sections begin with '^') }
180var
181 i: Integer;
182 x: string;
183begin
184 for i := 0 to BADiagnosis.Count - 1 do if CharAt(BADiagnosis[i], 1) = U then
185 begin
186 x := Piece(BADiagnosis[i], U, 2);
187 if Length(x) = 0 then x := '<No Section Name>';
188 Dest.Add(IntToStr(i) + U + Piece(BADiagnosis[i], U, 2) + U + x);
189 end;
190end;
191
192procedure TfrmBALocalDiagnoses.MainDriver;
193begin
194 BADiagnosis := TStringList.Create;
195 ECFDiagnosis := TStringList.Create;
196 uProblems := TStringList.Create;
197 lblPatientName.Caption := Patient.Name;
198 DeselectGridItems;
199
200 if whoCalled = F_CONSULTS then
201 ListConsultDX(uBAGlobals.BAConsultDxList)
202 else
203 ListGlobalDx(currentOrderIDList);
204
205 LoadEncounterForm;
206 ListDiagnosisSections(lbSections.Items);
207 ListSelectedOrders;
208 LoadTempDXLists;
209end;
210
211procedure TfrmBALocalDiagnoses.LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string);
212begin
213 if frmFrame.TimedOut then exit;
214 thisRec := TBADxRecord.Create;
215 UBAGlobals.InitializeNewDxRec(thisRec);
216 //** Load it
217 thisRec.FOrderID := thisOrderID;
218 if pos( '(', UBAGlobals.Dx1) > 0 then
219 thisRec.FBADxCode := UBACore.StripTFactors(UBAGlobals.Dx1)
220 else
221 thisRec.FBADxCode := UBAGlobals.Dx1;
222
223 if pos( '(', UBAGlobals.Dx2) > 0 then
224 thisRec.FBASecDx1 := UBACore.StripTFactors(UBAGlobals.Dx2)
225 else
226 thisRec.FBASecDx1 := UBAGlobals.Dx2;
227
228 if pos( '(', UBAGlobals.Dx3) > 0 then
229 thisRec.FBASecDx2 := UBACore.StripTFactors(UBAGlobals.Dx3)
230 else
231 thisRec.FBASecDx2 := UBAGlobals.Dx3;
232
233 if pos( '(', UBAGlobals.Dx4) > 0 then
234 thisRec.FBASecDx3 := UBACore.StripTFactors(UBAGlobals.Dx4)
235 else
236 thisRec.FBASecDx3 := UBAGlobals.Dx4;
237
238 //** Verify Diagnosis exists prior to adding to list.
239 if UBAGlobals.Dx1 <> '' then
240 BADiagnosis.Add(UBAGlobals.Dx1);
241 if UBAGlobals.Dx2 <> '' then
242 BADiagnosis.Add(UBAGlobals.Dx2);
243 if UBAGlobals.Dx3 <> '' then
244 BADiagnosis.Add(UBAGlobals.Dx3);
245 if UBAGlobals.Dx4 <> '' then
246 BADiagnosis.Add(UBAGlobals.Dx4);
247end;
248
249procedure TfrmBALocalDiagnoses.AssocDxToOrders;
250var
251 tmpFlagList: TStringList;
252 i: integer;
253 thisOrderID: string;
254 tempDxRec: TBADxRecord;
255 {$ifdef debug}thismsg: string;{$endif}
256begin
257 //** Initialize
258 if Assigned(UBAGlobals.OrderIDList) then
259 UBAGlobals.OrderIDList.Clear;
260 tmpFlagList := TStringList.Create;
261
262 //** Associate Dx's to Orders
263 if whoCalled = F_ORDERS_SIGN then
264 begin
265 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
266 begin
267 if (frmSignOrders.clstOrders.Selected[i]) then
268 begin
269 thisOrderID := TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
270 if Not UBACore.IsOrderBillable(thisOrderID) then Continue; //BAPHII 1.4.16
271 LoadTempRec(tempDxRec, thisOrderID);
272 if ((UBAGlobals.tempDxList <> nil) and (not UBAGlobals.tempDxNodeExists(thisOrderID))) then
273 UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec))
274 else
275 begin
276 //** Order already exists in Dx list, so modifiy existing Dx record
277 SetBADxListForOrder(tempDxRec, thisOrderID);
278 end;
279 //** Add it to OrderID string list
280 if Assigned(UBAGlobals.OrderIDList) then
281 UBAGlobals.OrderIDList.Add(thisOrderID);
282 end; //** if
283 end; //** for
284 end
285 else
286 if whoCalled = F_REVIEW then
287 begin
288 DeselectGridItems;
289 for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
290 begin
291 if (frmReview.lstReview.Selected[i]) then
292 begin
293 thisOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[i]).ID;
294 if Not UBACore.IsOrderBillable(thisOrderID) then Continue; //BAPHII 1.4.16
295 LoadTempRec(tempDxRec, thisOrderID);
296 if ((UBAGlobals.tempDxList <> nil) and (not UBAGlobals.tempDxNodeExists(thisOrderID))) then
297 UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec))
298 else
299 begin
300 //** Order already exists in Dx list, so modifiy existing Dx record
301 SetBADxListForOrder(tempDxRec, thisOrderID);
302 GetUnsignedOrderFlags(thisOrderID,tmpFlagList);
303 end;
304
305 //** Add it to OrderID string list
306 if Assigned(UBAGlobals.OrderIDList) then
307 UBAGlobals.OrderIDList.Add(thisOrderID);
308 end;
309 end; //for
310 end;
311end;
312
313procedure TfrmBALocalDiagnoses.buOKClick(Sender: TObject);
314begin
315 inherited;
316//*** Load selected diagnosis to Temp List*** /////
317
318 if whoCalled <> F_CONSULTS then
319 begin
320 BuildTempDxList; //** Loop thru dx grid and build list of dx's
321 BuildBADxList; //** Save selected Dx passed to PCE-Diagnosis Tab
322 AssocDxToOrders; //** Add selected Dx to TList for display and tracking.
323 end
324 else
325 begin
326 BuildConsultDxList(UBAGlobals.BAConsultDxList); //** Loop thru dx grid and build list of dx's
327 fODConsult.consultQuickOrder := False; // allow multiple dx's if first selection was a quick order
328 end;
329 ProcessAddToItems; //** Items flagged with 'add' will be added to the Problem list table
330 lvDxGrid.Clear;
331 frmBALocalDiagnoses.Close;
332
333end;
334
335procedure TfrmBALocalDiagnoses.LoadEncounterForm;
336{ load the major coding lists that are used by the encounter form for a given location }
337var
338 i: integer;
339 uTempList: TStringList;
340 EncDt: TFMDateTime;
341begin
342 uLastLocation := Encounter.Location;
343 EncDt := Trunc(FMToday);
344 // ** add problems to the top of diagnoses.
345 uTempList := TstringList.Create;
346 BADiagnosis.clear;
347 tCallV(uTempList,'ORWPCE DIAG', [uLastLocation, EncDt]);
348 BADiagnosis.add(utemplist.strings[0]);
349 AddProbsToDiagnosis;
350
351 // ** Loading Diagnoses if previously entered via the Encounter Form
352 AddPersonalDxToDiagnosisList;
353
354 if Assigned(BAPCEDiagList) then
355 begin
356 AddPCEToDiagnosis;
357 end;
358
359 for i := 1 to (uTempList.Count-1) do
360 BADiagnosis.add(uTemplist.strings[i]);
361
362end;
363
364// ** Add problem-list enteries to Diagnosis selection list
365procedure TfrmBALocalDiagnoses.AddProbsToDiagnosis;
366var
367 i : integer;
368 EncDt: TFMDateTime;
369 ProblemListTFactors: string;
370begin
371 // ** Get problem list
372 EncDt := Trunc(FMToday);
373 uLastDFN := Patient.DFN;
374 tCallV(UProblems, 'ORWPCE ACTPROB', [Patient.DFN, EncDT]);
375
376 if uProblems.Count > 0 then
377 begin
378 BADiagnosis.add('^Problem List Items');
379 for i := 1 to (uProblems.count-1) do
380 begin
381 // ** add PL Treatment Factors to Dx Display List.
382 //HDS00006194 if (Piece(uproblems.Strings[i],U,3) = '799.9') then continue;
383 //HDS00006194 if (Piece(uproblems.Strings[i],U,2) = '799.9') then continue;
384 // change made to allow 799.9 into selection list
385 AttachPLTFactorsToDx(ProblemListTFactors,uProblems.Strings[i]);
386
387 if (Piece(uproblems.Strings[i], U, 11) = '#') then
388 begin
389 BADiagnosis.add(Piece(uProblems.Strings[i],U,3) + U + // PL code inactive
390 Piece(uProblems.Strings[i],U,2) + U + '#');
391 inc(inactiveCodes);
392 end
393 else if (Piece(uproblems.Strings[i], U, 10) = '') then // no inactive date for code
394 BADiagnosis.add(ProblemListTFactors)
395 else if (Trunc(StrToFloat(Piece(uProblems.Strings[i], U, 10))) > EncDT) then // code active as of EncDt
396 BADiagnosis.add(Piece(uProblems.Strings[i],U,3) + U +
397 ProblemListTFactors )
398 else
399 BADiagnosis.add(Piece(uProblems.Strings[i],U,3) + U + // PL code inactive
400 Piece(uProblems.Strings[i],U,2) + U + '#');
401 end;
402 end;
403end;
404
405procedure TfrmBALocalDiagnoses.AddPCEToDiagnosis;
406var
407 i: integer;
408begin
409 for i := 0 to (BAPCEDiagList.Count-1) do
410 begin
411 if CharAt(BAPCEDiagList.Strings[i], 1) = U then
412 BADiagnosis.Add(BAPCEDiagList.Strings[i]) //** section header
413 else
414 BADiagnosis.add(Piece(BAPCEDiagList.Strings[i],U,1) + U + Piece(BAPCEDiagList.Strings[i],U,2));
415 end;
416end;
417
418procedure TfrmBALocalDiagnoses.AddPersonalDxToDiagnosisList;
419var
420 personalDxList: TStringList;
421 personalDxListSorted: TStringList;
422 i,z: integer;
423begin
424
425 personalDxList := TStringList.Create;
426 personalDxListSorted := TStringlist.Create;
427 personalDxList.Clear;
428 personalDxListSorted.Clear;
429 personalDxList := rpcGetPersonalDxList(User.DUZ);
430 for i := 0 to personalDxList.Count-1 do
431 personalDxListSorted.Add(Piece(personalDXList.Strings[i],U,2) + U + (Piece(personalDXList.Strings[i],U,1)) );
432 //****** sort personal dx list alphabetical by code name
433 personalDxListSorted.Sorted := False;
434 personalDxListSorted.Sorted := True ;
435 personalDxList.Clear;
436 for z := 0 to personalDxListSorted.Count-1 do
437 personalDxList.Add(Piece(personalDXListSorted.Strings[z],U,2) + U + (Piece(personalDXListSorted.Strings[z],U,1)) );
438
439
440 if personalDxList.Count > 0 then
441 begin
442 BADiagnosis.add(U + DX_PERSONAL_LIST_TXT);
443 for i := 0 to personalDxList.Count-1 do
444 BADiagnosis.Add(personalDxList.Strings[i]);
445 end
446 else
447 BADiagnosis.add('^NO Personal Diagnoses Available');
448end;
449
450
451procedure TfrmBALocalDiagnoses.buCancelClick(Sender: TObject);
452begin
453 lvDxGrid.Clear;
454 fODConsult.displayDXCode := 'DXCANCEL';// retain original dx in consult dialog
455 uBAGlobals.TFactors := ''; // clear treatment factors from last order.// hds00006266
456 Close;
457end;
458
459procedure TfrmBALocalDiagnoses.Button4Click(Sender: TObject);
460begin
461 Close;
462end;
463
464procedure TfrmBALocalDiagnoses.lbSectionsClick(Sender: TObject);
465var i: integer;
466begin
467 for i := 0 to lbSections.Items.Count-1 do
468 begin
469 if(lbSections.Selected[i]) then
470 begin
471 lvDxGrid.ClearSelection;
472 ClearAndDisableCBoxes;
473 ListDiagnosisCodes(lbSections.Items[i]);
474 FDXSection := lbSections.Items[i];
475 Break;
476 end;
477 end;
478end;
479
480procedure TfrmBALocalDiagnoses.ListDiagnosisCodes(Section: String);
481var
482i,j: integer;
483a: string;
484begin
485 lbDiagnosis.Clear;
486
487 for i := 0 to BADiagnosis.Count-1 do
488 begin
489 a := BADiagnosis.Strings[i];
490 if Piece(BADiagnosis[i], U, 2) = (Piece(Section,U,2)) then
491 Break;
492 end;
493
494 inc(i);
495
496 for j := i to BADiagnosis.Count-1 do
497 begin
498 if Piece(BADiagnosis[j], U, 0) = '' then
499 break
500 else
501 begin
502 a := Piece(BADiagnosis[j], U, 2) + U + Piece(BADiagnosis[j], U, 1) + U + ' ' + Piece(BADiagnosis[j], U, 3) ;
503 if a = '' then showmessage('found nothing');
504 lbDiagnosis.Items.Add(a);
505 end;
506 end;
507end;
508
509procedure TfrmBALocalDiagnoses.btnOtherClick(Sender: TObject);
510var
511 Match: string;
512 selectedDx: string;
513 i: integer;
514 lexIEN: string;
515begin
516 lvDxGrid.ClearSelection;
517 ProvDx.Code := ''; //** init
518 lexIEN := '';
519 BAPersonalDX := True; //** returns LexIEN in piece 3
520 //** Execute LEXICON
521 LexiconLookup(Match, LX_ICD);
522 if Match = '' then Exit;
523 fOrdersSign.ProvDx.Code := Piece(Match, U, 1);
524 fOrdersSign.ProvDx.Text := Piece(Match, U, 2);
525 lexIEN := Piece(Match, U, 3);
526 i := Pos(' (ICD', fOrdersSign.ProvDx.Text);
527 if i = 0 then i := Length(ProvDx.Text) + 1;
528 if fOrdersSign.ProvDx.Text[i-1] = '*' then i := i - 2;
529 fOrdersSign.ProvDx.Text := Copy(fOrdersSign.ProvDx.Text, 1, i - 1);
530 fOrdersSign.ProvDx.Text := StringReplace(fOrdersSign.ProvDx.Text,':',' ',[rfReplaceAll]);
531 fOrdersSign.ProvDx.Code := StringReplace(fOrdersSign.ProvDx.Code,':',' ',[rfReplaceAll]);
532
533 selectedDx := (fOrdersSign.ProvDx.Text + ':' + fOrdersSign.ProvDx.Code);
534 if strLen(PChar(lexIEN) ) > 0 then
535 lexIENHoldList.Add(fOrdersSign.ProvDx.Code + U + lexIEN);
536
537 //** Begin CQ4819
538 if not IsDxAlreadySelected(selectedDx) then
539 begin
540 if UBACore.IsICD9CodeActive(fOrdersSign.ProvDx.Code,'ICD',0) then
541 DiagnosisSelection(selectedDx)
542 else
543 InfoBox(BA_INACTIVE_ICD9_CODE_1 + fOrdersSign.ProvDx.Code + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
544 end;
545 //** End CQ4819
546 BAPersonalDX := False;
547 SetAddToCheckBoxStatus(selectedDX);
548
549end;
550
551procedure TfrmBALocalDiagnoses.btnPrimaryClick(Sender: TObject);
552var
553 i: shortint;
554 Primary: boolean;
555begin
556 inherited;
557 Primary := FALSE;
558 if lvDxGrid.Items.Count = 0 then Exit; //** Exit if list empty
559 for i := 0 to lvDxGrid.Items.Count-1 do
560 begin
561 if(lvDxGrid.Items[i].Selected) then
562 begin
563 if not Primary then
564 begin
565 LvDxGrid.Items[i].SubItems[0] := UBAConst.PRIMARY_DX;
566 Primary :=TRUE;
567 end;
568 end
569 else
570 LvDxGrid.Items[i].SubItems[0] := UBAConst.SECONDARY_DX ;
571 end;
572
573 if not Primary then EnsurePrimary;
574end;
575
576procedure TfrmBALocalDiagnoses.btnRemoveClick(Sender: TObject);
577begin
578 inherited;
579 deleteDX := True;
580 lvDxGrid.DeleteSelected;
581 ClearAndDisableCBoxes;
582 DeselectGridItems;
583 EnsurePrimary;
584 deleteDX := False;
585 // if all dx's removed, clear out displaycode
586 if lvDxGrid.items.Count = 0 then FODConsult.displayDXCode := '';
587end;
588
589procedure TfrmBALocalDiagnoses.btnSelectAllClick(Sender: TObject);
590var
591 i: integer;
592begin
593 inherited;
594 for i := 0 to lvDxGrid.Items.Count-1 do
595 begin
596 if cbAddToPDList.Enabled then
597 SetAddToCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]); //** personal dx
598 if cbAddToPL.Enabled then
599 SetAddToCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]);; //** problem dx
600 end;
601
602 lvDxGrid.MultiSelect := true;
603 lvDxGrid.SelectAll;
604 lvDxGrid.Setfocus;
605end;
606
607procedure TfrmBALocalDiagnoses.DiagnosisSelection(SelectedDx: String);
608begin
609// ** Set up Dx grid
610 if lvDxGrid.Items.Count < MaxDx then
611 begin
612 if lvDxGrid.Items.count = 0 then
613 begin
614 ListItem := lvDxGrid.Items.Add; // ** add the row instance prior to adding text // adding text.
615 ListItem.SubItems.Add(UBAConst.PRIMARY_DX);
616 ListItem.SubItems.Add(SelectedDX);
617 end
618 else
619 begin
620 DeselectGridItems;
621 ListItem := lvDxGrid.Items.Add; // ** add the row instance prior to adding text.
622 ListItem.SubItems.Add(UBAConst.SECONDARY_DX);
623 ListItem.SubItems.Add(SelectedDX);
624 end;
625 end
626 else
627 begin
628 DeselectGridItems;
629 ShowMessage(BA_MAX_DX); //** max 4 diagnoses per order
630 end;
631end;
632
633// insure unique diagnoses entered.
634function TfrmBALocalDiagnoses.IsDxAlreadySelected(SelectedDx: string):boolean;
635var i: integer;
636x: string;
637begin
638 Result := False;
639 with lvDxGrid do
640 begin
641 for i := 0 to lvDxGrid.Items.Count-1 do
642 begin
643 x := lvDxGrid.Items[i].Subitems[1];
644 if Piece(x,':',2) = Piece(SelectedDx,':',2) then
645 begin
646 Result := True;
647 Break;
648 end;
649 end;
650 end;
651end;
652
653function TFrmBALocalDiagnoses.ProblemListDxFound(pDxCode:string):boolean;
654var
655 i: integer;
656 problemDx: string;
657begin
658 Result := False;
659 for i := 0 to ProblemDXHoldList.Count -1 do
660 begin
661 problemDX := ProblemDXHoldList.Strings[i];
662 problemDX := Piece(ProblemDX,':',2);
663 if pDxCode = problemDX then
664 begin
665 Result := True;
666 break;
667 end;
668 end;//** for
669end;
670
671function TFrmBALocalDiagnoses.PersonalListDxFound(pDxCode:string):boolean;
672var
673 i: integer;
674 personalDx: string;
675begin
676 Result := False;
677 for i := 0 to PersonalDxHoldList.Count -1 do
678 begin
679 personalDX := PersonalDXHoldList.Strings[i];
680 personalDX := Piece(personalDX,':',2);
681 if pDxCode = personalDX then
682 begin
683 Result := True;
684 break;
685 end;
686 end;
687end;
688
689
690procedure TfrmBALocalDiagnoses.EnsurePrimary;
691var
692 Primary: boolean;
693 i : integer;
694begin
695 Primary := False;
696
697 for i := 0 to lvDxGrid.Items.Count-1 do
698 begin
699 if LvDxGrid.Items[i].SubItems[0] = UBAConst.PRIMARY_DX then
700 begin
701 Primary := True;
702 Break;
703 end;
704 end;
705
706 if not Primary then
707 begin
708 if lvDxGrid.Items.Count > 0 then
709 lvDxGrid.Items[0].Subitems[0] := UBAConst.PRIMARY_DX;
710 end;
711end;
712
713procedure TfrmBALocalDiagnoses.cbAddToPLClick(Sender: TObject);
714var i: integer;
715begin
716 inherited;
717 if cbAddToPL.Checked then
718 begin
719 for i := 0 to lvDxGrid.Items.Count-1 do
720 begin
721 if(lvDxGrid.Items[i].Selected) then
722 begin
723 lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked);
724 cbaddToPL.Checked := true;
725 lvDxGrid.Items[i].Selected := True;
726 lvDxGrid.SetFocus;
727 end;
728 end;
729 end
730 else
731 begin
732 if not cbaddToPL.Checked then
733 for i := 0 to lvDxGrid.Items.Count-1 do
734 begin
735 if(lvDxGrid.Items[i].Selected) then
736 begin
737 lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked);
738 lvDxGrid.Items[i].Selected := True;
739 lvDxGrid.SetFocus;
740 end;
741 end;
742end;
743 EnsurePrimary;
744end;
745
746procedure TfrmBALocalDiagnoses.ProcessAddToItems;
747begin
748 AddToProblemList;
749 AddToPersonalDxList;
750end;
751
752
753procedure TfrmBALocalDiagnoses.AddToPersonalDxList;
754var
755 i,j: integer;
756 tempcode,thisCode : string;
757 tempList, addToPDList: TStringList;
758begin
759 templist := TStringList.Create;
760 addToPDList := TStringList.Create;
761 tempList.Clear;
762 addTOPDList.Clear;
763 with lvDxGrid do
764 begin
765 for i := 0 to Items.Count-1 do
766 begin
767 if StrPos(PChar(LvDxGrid.Items[i].Caption),PChar(ADD_TO_PERSONAL_DX_LIST)) <> nil then
768 begin
769 tempCode := lvDxGrid.Items[i].Subitems[1];
770 tempCode := Piece(tempCode, ':', 2);
771 tempList.Add(tempCode);
772 end;
773 end;
774 end;
775
776 //** add Lexicon IEN to list (if any)
777 for i := 0 to tempList.Count -1 do
778 begin
779 thisCode := tempList.Strings[i];
780 if lexIENHoldList.Count > 0 then //HDS6393
781 begin
782 for j := 0 to lexIENHoldList.Count-1 do
783 begin
784 if thisCode = Piece(lexIENHoldList.Strings[j],U,1) then
785 AddToPDList.Add(thisCode + U + Piece(lexIENHoldList.Strings[j],U,2) ) // code was selected from Lexicon
786 else
787 AddToPDList.Add(thisCode);
788 end;
789 end
790 else //HDS6393
791 AddToPDList.Add(thisCode); // code was not selected from the Lexicon. //HDS6393
792 end;
793 if AddToPDList.Count > 0 then
794 rpcAddToPersonalDxList(User.DUZ,AddToPDList);
795end;
796
797
798procedure TfrmBALocalDiagnoses.AddToProblemList;
799var
800 i: integer;
801 tempCode, passCode: string;
802 NewList: TStringList;
803 PatientInfo:string;
804 ProviderID:string;
805 ptVAMC:string;
806
807begin
808 PatientInfo := Patient.DFN + U + Patient.Name + U;
809 ProviderID := IntToStr(Encounter.Provider);
810 ptVAMC := '';
811 NewList := TStringList.Create;
812 NewList.Clear;
813 // ** Add Diagnosis to Problem List if flagged with 'Add' in First Col.
814 with lvDxGrid do
815 begin
816 for i := 0 to Items.Count-1 do
817 begin
818 if StrPos(PChar(LvDxGrid.Items[i].Caption),PChar(ADD_TO_PROBLEM_LIST)) <> nil then
819 begin
820 tempCode := lvDxGrid.Items[i].Subitems[1];
821 // ** passCode consists of Dx Code '^' Dx Desc /////
822 passCode := Piece(tempCode,':',2) + U + Piece(tempCode,':',1);
823 if Piece(passCode,U,1) <> TX799 then
824 begin
825 NewList := BAPLRec.BuildProblemListDxEntry(passCode);
826 CallV('ORQQPL ADD SAVE',[PatientInfo, ProviderID, BAPLPt.PtVAMC, NewList]);
827 NewList.Free;
828 end;
829 end;
830 end;
831 end;
832end;
833
834procedure TfrmBALocalDiagnoses.BuildConsultDxList(pDxList: TStringList); // ** adds grid items to BAConsultDxList - uConsults
835var
836 i: integer;
837 x: string;
838begin
839 UBAGlobals.BAConsultDxList.Clear;
840
841 if lvDxGrid.Items.Count > 0 then
842 with lvDxGrid do
843 begin
844 for i := 0 to Items.Count-1 do
845 begin
846 if i = 0 then fODConsult.displayDXCode := lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1];
847 x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1];
848 if Piece(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1],U,1) = PRIMARY_DX then
849 fODConsult.displayDXCode := Piece(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1],U,2);
850 uBAGlobals.BAConsultDxList.Add(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]);
851 end;
852 uBAGlobals.BAConsultDxList.Sort;
853 end
854 else
855 uBAGlobals.BAConsultDxList.Clear;
856end;
857
858
859procedure TfrmBALocalDiagnoses.BuildTempDxList;
860var
861 i : integer;
862 tempStr1,tempStr2, tempStr3: string;
863 tempFactor1,x: string;
864 tempStrList: TStringList;
865begin
866 tempStrList := TStringList.Create;
867 if Assigned(tempStrList) then tempStrList.Clear;
868
869 UBAGlobals.Dx1 := '';
870 UBAGlobals.Dx2 := '';
871 UBAGlobals.Dx3 := '';
872 UBAGlobals.Dx4 := '';
873 UBAGlobals.TFactors := '';
874 tempstr1 := '';
875 tempstr2 := '';
876 tempstr3 := '';
877 tempFactor1 := '';
878
879 if lvDxGrid.Items.Count > 0 then
880 with lvDxGrid do
881 begin
882 for i := 0 to Items.Count-1 do
883 begin
884 x := lvDxGrid.Items[i].Subitems[0];
885 x := lvDxGrid.Items[i].Subitems[1];
886 x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1];
887 tempStrList.Add(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]);
888 end;
889 if tempStrList.Count > 0 then
890 tempStrList.Sort; //** Sort list Ascending order.
891 with tempStrList do
892 begin
893 tempFactor1 := (Piece(tempStrList.Strings[0],'(',2)); //** 0 = Primary
894 tempFactor1 := (Piece(tempFactor1,')',1) );
895 if (Length(tempFactor1) > 0) then
896 UBAGLobals.TFactors := tempFactor1;
897 for i := 0 to tempStrList.Count-1 do
898 begin
899 tempstr1 := (Piece(tempStrList.Strings[i],U,2));
900 tempstr2 := (Piece(tempstr1,':',1) + '^'+ Piece(tempstr1,':',2));
901 if i = 0 then //** has primary dx changed
902 begin
903 if tempStr2 <> uPrimaryDxHold then
904 begin
905 if tempStr2 <> '' then
906 PrimaryChanged := True;
907 end;
908 end;
909 if tempstr2 = U then
910 tempstr2 := DXREC_INIT_FIELD_VAL;
911 case i of
912 0: UBAGlobals.Dx1 := tempStr2;
913 1: UBAGlobals.Dx2 := tempStr2;
914 2: UBAGlobals.Dx3 := tempStr2;
915 3: UBAGlobals.Dx4 := tempStr2;
916 else
917 Exit;
918 end;
919 end;
920 end;
921 end
922 else
923 if lvDxGrid.Items.Count = 0 then
924 begin
925 UBAGlobals.Dx1 := DXREC_INIT_FIELD_VAL;
926 UBAGlobals.Dx2 := DXREC_INIT_FIELD_VAL;
927 UBAGlobals.Dx3 := DXREC_INIT_FIELD_VAL;
928 UBAGlobals.Dx4 := DXREC_INIT_FIELD_VAL;
929 end;
930end;
931
932procedure TfrmBALocalDiagnoses.BuildBADxList;
933begin
934 if not assigned(BADiagnosisList) then
935 begin
936 BADiagnosisList := TStringList.Create;
937 BADiagnosisList.Duplicates := dupIgnore;
938 BADiagnosisList.Sorted := True;
939 end;
940
941 if UBAGlobals.Dx1 <> '' then
942 BADiagnosisList.Add(U + UBAGlobals.Dx1 + U);
943
944 if UBAGlobals.Dx2 <> '' then
945 BADiagnosisList.Add(U + UBAGlobals.Dx2 + U);
946
947 if UBAGlobals.Dx3 <> '' then
948 BADiagnosisList.Add(U + UBAGlobals.Dx3 + U);
949
950 if UBAGlobals.Dx4 <> '' then
951 BADiagnosisList.Add(U + UBAGlobals.Dx4 + U);
952end;
953
954procedure TfrmBALocalDiagnoses.ListConsultDX(pOrderDxList: TStringList);
955var
956 i: integer;
957 dx1,dx2,dx3,dx4: string;
958 begin
959 if UBAGlobals.BAConsultDxList.Count = 0 then Exit;
960 dx1 := '';
961 dx2 := '';
962 dx3 := '';
963 dx4 := '';
964 for i := 0 to BAConsultDxList.Count-1 do
965 begin
966 case i of
967 0: dx1 := BAConsultDxList.Strings[i];
968 1: dx2 := BAConsultDxList.Strings[i];
969 2: dx3 := BAConsultDxList.Strings[i];
970 3: dx4 := BAConsultDxList.Strings[i];
971 end;
972 end;
973
974 ListItem := lvDxGrid.Items.Add;
975 if Length(dx1) > 0 then
976 ListItem.SubItems.Add(UBAConst.PRIMARY_DX)
977 else
978 ListItem.SubItems.Add(DXREC_INIT_FIELD_VAL);
979 ListItem.SubItems.Add(Piece(dx1,U,2));
980
981 if Length(dx2) > 1 then
982 begin
983 ListItem := lvDxGrid.Items.Add;
984 ListItem.SubItems.Add(UBAConst.SECONDARY_DX);
985 ListItem.SubItems.Add(Piece(dx2,U,2));
986 end;
987
988 if Length(dx3) > 1 then
989 begin
990 ListItem := lvDxGrid.Items.Add;
991 ListItem.SubItems.Add(UBAConst.SECONDARY_DX);
992 ListItem.SubItems.Add(Piece(dx3,U,2));
993 end;
994
995 if Length(dx4) > 1 then
996 begin
997 ListItem := lvDxGrid.Items.Add;
998 ListItem.SubItems.Add(UBAConst.SECONDARY_DX);
999 ListItem.SubItems.Add(Piece(dx4,U,2));
1000 end;
1001end;
1002
1003procedure TfrmBALocalDiagnoses.ListGlobalDx(pOrderIDList: TStringList); // need to get rec based on orderid
1004var
1005 i :integer;
1006begin
1007
1008 if not Assigned(UBAGlobals.globalDxRec) then Exit;
1009
1010 if (Assigned(UBAGlobals.globalDxRec)) and (UBAGlobals.globalDxRec.FBADxCode = '') then Exit;
1011
1012 for i := 0 to pOrderIDList.Count-1 do
1013 begin
1014 if tempDxNodeExists(pOrderIDList.Strings[i]) then
1015 begin
1016 UBAGlobals.globalDxRec.FOrderID := pOrderIDList.Strings[i];
1017 break;
1018 end;
1019 end;
1020 ListItem := lvDxGrid.Items.Add;
1021 if Length(UBAGlobals.globalDxRec.FBADxCode) > 0 then
1022 ListItem.SubItems.Add(UBAConst.PRIMARY_DX)
1023 else
1024 ListItem.SubItems.Add(DXREC_INIT_FIELD_VAL);
1025 uPrimaryDxHold := UBAGlobals.globalDxRec.FBADxCode;
1026 ListItem.SubItems.Add(UBAGlobals.globalDxRec.FBADxCode);
1027
1028 if Length(UBAGlobals.globalDxRec.FBASecDx1) > 1 then
1029 begin
1030 ListItem := lvDxGrid.Items.Add;
1031 ListItem.SubItems.Add(UBAConst.SECONDARY_DX);
1032 ListItem.SubItems.Add(UBAGlobals.globalDxRec.FBASecDx1);
1033 end;
1034
1035 if Length(UBAGlobals.globalDxRec.FBASecDx2) > 1 then
1036 begin
1037 ListItem := lvDxGrid.Items.Add;
1038 ListItem.SubItems.Add(UBAConst.SECONDARY_DX);
1039 ListItem.SubItems.Add(UBAGlobals.globalDxRec.FBASecDx2);
1040 end;
1041
1042 if Length(UBAGlobals.globalDxRec.FBASecDx3) > 1 then
1043 begin
1044 ListItem := lvDxGrid.Items.Add;
1045 ListItem.SubItems.Add(UBAConst.SECONDARY_DX);
1046 ListItem.SubItems.Add(UBAGlobals.globalDxRec.FBASecDx3);
1047 end;
1048end;
1049
1050procedure TfrmBALocalDiagnoses.lbDiagnosisClick(Sender: TObject);
1051var
1052 i : integer;
1053 newDxCode, initDxCode: string;
1054begin
1055 inherited;
1056 for i := 0 to lbDiagnosis.Count-1 do
1057 begin
1058 if(lbDiagnosis.Selected[i]) then
1059 begin
1060 initDxCode := StringReplace(lbDiagnosis.Items[i],':',' ',[rfReplaceAll]);
1061 newDxCode := (Piece(initDxCode,U,1) + ':'+ Piece(initDxCode,U,2));
1062 if UBACore.IsICD9CodeActive(Piece(newDxCode,':',2),'ICD',Encounter.DateTime) then
1063 begin
1064 if not IsDxAlreadySelected(newDxCode) then
1065 begin
1066 DiagnosisSelection(newDxCode);
1067 SetAddToCheckBoxStatus(newDxCode);
1068 end
1069 else
1070 begin
1071 DeselectGridItems;
1072 lvDxGrid.Items[lvDxGrid.items.Count-1].Selected := true;
1073 InfoBox(BA_DUP_DX_DISALLOWED_1 + Piece(newDxCode,':',2) + BA_DUP_DX_DISALLOWED_2,BA_DUP_DX ,MB_ICONINFORMATION or MB_OK);
1074 end;
1075 end
1076 else
1077 InfoBox(BA_INACTIVE_ICD9_CODE_1 + Piece(newDxCode,':',2) + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
1078 end;
1079 end;
1080end;
1081
1082
1083procedure TfrmBALocalDiagnoses.DeselectGridItems;
1084var
1085i: integer;
1086begin
1087 if lvDxGrid.Items.Count = 0 then
1088 lvDxGrid.Clear
1089 else
1090 begin
1091 for i := 0 to lvDxGrid.Items.Count-1 do
1092 lvDxGrid.Items[i].Selected := false;
1093 end;
1094end;
1095
1096procedure TfrmBALocalDiagnoses.FormActivate(Sender: TObject);
1097begin
1098 inherited;
1099 InactiveICDNotification;
1100end;
1101
1102procedure TfrmBALocalDiagnoses.FormShow(Sender: TObject);
1103begin
1104 lbSections.Selected[0] := false;
1105
1106 if lbSections.Count > 0 then
1107 ListDiagnosisCodes(lbSections.Items[0]);
1108end;
1109
1110procedure TfrmBALocalDiagnoses.ListSelectedOrders;
1111var i: integer;
1112begin
1113 if BAtmpOrderList.Count > 0 then
1114 try
1115 for i:= 0 to BAtmpOrderList.Count -1 do
1116 begin
1117 lbOrders.Items.Add(StringReplace(BAtmpOrderList.Strings[i],CRLF,' ',[rfReplaceAll]) );
1118
1119 end;
1120 except
1121 on EListError do
1122 begin
1123 {$ifdef debug}ShowMessage('EListError in frmBALocalDiagnoses.ListSelectedOrders()');{$endif}
1124 raise;
1125 end;
1126 end; //try
1127
1128end;
1129
1130procedure TfrmBALocalDiagnoses.AddDiagnosistoPersonalDiagnosesList1Click(Sender: TObject);
1131var
1132 i: integer;
1133 pCodeList: TStringList;
1134 selectedList: TStringList;
1135begin
1136 inherited;
1137 pCodeList := TStringList.Create;
1138 selectedList := TStringList.Create;
1139
1140 if Assigned(pCodeList) then pCodeList.Clear;
1141 if Assigned(selectedList) then selectedList.Clear;
1142
1143 try
1144 for i := 0 to lbDiagnosis.Items.Count-1 do
1145 if(lbDiagnosis.Selected[i]) then
1146 selectedList.Add((Piece(lbDiagnosis.Items[i],U,2)) );
1147 except
1148 on EListError do
1149 begin
1150 {$ifdef debug}ShowMessage('EListError in frmBALocalDiagnoses.AddDiagnosisToPersonalDiagnosesListClick()');{$endif}
1151 raise;
1152 end;
1153 end; //try
1154
1155 if selectedList.Count > 0 then
1156 if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then
1157 begin
1158 ShowMessage(UBAMessages.BA_PERSONAL_LIST_UPDATED);
1159 LoadEncounterForm;
1160 Refresh;
1161 end;
1162
1163end;
1164
1165procedure TfrmBALocalDiagnoses.AddDiagnosistoPersonalDiagnosesList2Click(
1166 Sender: TObject);
1167 var i:integer;
1168 selectedList: TStringList;
1169begin
1170 inherited;
1171 selectedList := TStringList.Create;
1172 if Assigned(selectedList) then selectedList.create;
1173
1174 for i := 0 to lvDxGrid.Items.Count-1 do
1175 begin
1176 if(lvDxGrid.Items[i].Selected) then
1177 selectedList.Add( piece(LvDxGrid.Items[i].SubItems[1],':',2) );
1178 end;
1179 if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then
1180 begin
1181 ShowMessage(UBAMessages.BA_PERSONAL_LIST_UPDATED);
1182 LoadEncounterForm;
1183 Refresh;
1184 end;
1185end;
1186
1187
1188procedure TfrmBALocalDiagnoses.cbAddToPDListClick(Sender: TObject);
1189var i: integer;
1190begin
1191 inherited;
1192
1193 if cbAddToPDList.Checked then
1194 begin
1195 for i := 0 to lvDxGrid.Items.Count-1 do
1196 begin
1197 if(lvDxGrid.Items[i].Selected) then
1198 begin
1199 lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked);
1200 cbaddToPDList.Checked := true;
1201 lvDxGrid.SetFocus;
1202 end
1203 else
1204 if(lvDxGrid.Items[i].Selected) then
1205 begin
1206 lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked);
1207 cbaddToPL.Checked := false;
1208 lvDxGrid.SetFocus;
1209 end;
1210 end;
1211 end
1212 else
1213 begin
1214 if not cbaddToPDList.Checked then
1215 for i := 0 to lvDxGrid.Items.Count-1 do
1216 begin
1217 if(lvDxGrid.Items[i].Selected) then
1218 lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked);
1219 end;
1220end;
1221 EnsurePrimary;
1222end;
1223
1224function TfrmBALocalDiagnoses.AddToWhatList(IsPLChecked:boolean; IsPDLChecked:boolean):string;
1225begin
1226 Result := '';
1227
1228 if IsPLChecked and IsPDLChecked then
1229 Result := 'PL/PD'
1230 else
1231 if IsPLChecked then
1232 Result := 'PL'
1233 else
1234 if IsPDLChecked then
1235 Result := 'PD';
1236
1237end;
1238
1239procedure TfrmBALocalDiagnoses.InactiveICDNotification;
1240begin
1241 if inactiveCodes > 0 then
1242 begin
1243 if (not BAFWarningShown) and (inactiveCodes > 0) then
1244 begin
1245 InfoBox('There are ' + IntToStr(inactiveCodes) + ' active problem(s) flagged with a "#" as having' + #13#10 +
1246 'inactive ICD codes as of today''s date. Please correct these' + #13#10 +
1247 'problems via the Problems Tab - Change" option.', 'Inactive ICD Codes Found', MB_ICONWARNING or MB_OK);
1248 BAFWarningShown := True;
1249 end;
1250 end;
1251end;
1252
1253procedure TfrmBALocalDiagnoses.lbSectionsDrawItem(Control: TWinControl;
1254 Index: Integer; Rect: TRect; State: TOwnerDrawState);
1255begin
1256 inherited;
1257 lbsections.Font.Size := MainFontSize;
1258 if (control as Tlistbox).items[index] = DX_PROBLEM_LIST_TXT then
1259 (Control as TListBox).Canvas.Font.Style := [fsBold]
1260 else
1261 if (control as Tlistbox).items[index] = DX_PERSONAL_LIST_TXT then
1262 (Control as TListBox).Canvas.Font.Style := [fsBold]
1263 else
1264 if (control as Tlistbox).items[index] = DX_ENCOUNTER_LIST_TXT then
1265 (Control as TListBox).Canvas.Font.Style := [fsBold];
1266
1267 (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as
1268 TListBox).Items[Index]); {** display the text }
1269end;
1270
1271//** Loads string lists containing Diagnoses contained in the Problem and Personal DX List.
1272//** These lists will be used to insure duplicates can not be entered via add to check boxes.
1273procedure TfrmBALocalDiagnoses.LoadTempDXLists;
1274var
1275 i: integer;
1276 sChar,probDX,x: string;
1277 updatingProblemList, updatingPersonalList: boolean;
1278begin
1279 sChar := ')';
1280 updatingProblemList := FALSE;
1281 updatingPersonalList := FALSE;
1282 if Assigned(ProblemDxHoldList) then ProblemDxHoldList.Clear;
1283 if Assigned(PersonalDxHoldList) then PersonalDxHoldList.Clear;
1284 for i := 0 to BADiagnosis.Count - 1 do
1285 begin
1286 x := BADiagnosis.Strings[i];
1287 if CharAt(BADiagnosis[i], 1) = U then
1288 begin
1289 if Piece(BADiagnosis.Strings[i],U,2) = PROBLEM_LIST_SECTION then
1290 begin
1291 updatingProblemList := TRUE;
1292 updatingPersonalList := FALSE;
1293 end
1294 else
1295 begin
1296 if Piece(BADiagnosis.Strings[i],U,2) = PERSONAL_DX_SECTION then
1297 begin
1298 updatingProblemList := FALSE;
1299 updatingPersonalList := TRUE;
1300 end
1301 else
1302 begin
1303 updatingProblemList := FALSE;
1304 updatingPersonalList := FALSE;
1305 end;
1306 end;
1307 end;
1308 if updatingProblemList then
1309 begin
1310 if Piece(BADiagnosis.Strings[i],U,2) = PROBLEM_LIST_SECTION then lbSections.Selected[0] := true;
1311 if strPos(pChar(BADiagnosis.Strings[i]) , pChar(sChar) ) <> nil then
1312 begin
1313 probDX := StringReplace(BADiagnosis.Strings[i],'(','^',[rfReplaceAll]);
1314 probDX := StringReplace(probDX,')','^',[rfReplaceAll]);
1315 probDX := Piece(probDX,U,2) + ':' + Piece(probDX,U,1);
1316 probDX := StringReplace(probDX,' ','',[rfReplaceAll]);
1317 ProblemDXHoldList.Add(probDX);
1318 end
1319 else
1320 ProblemDxHoldList.Add(Piece(BADiagnosis.Strings[i],U,2) +':' +Piece(BADiagnosis.Strings[i],U,1) );
1321 end
1322 else
1323 if updatingPersonalList then
1324 PersonalDxHoldList.Add(Piece(BADiagnosis.Strings[i],U,2) + ':' + Piece(BADiagnosis.Strings[i],U,1) );
1325 end;
1326end;
1327
1328procedure TfrmBALocalDiagnoses.lvDxGridKeyDown(Sender: TObject;
1329 var Key: Word; Shift: TShiftState);
1330begin
1331 inherited;
1332 if(ssShift in Shift) or(ssCtrl in Shift) then
1333 selectingDX := True;
1334end;
1335
1336//** set Add To Check Boxes status.
1337procedure TfrmBALocalDiagnoses.SetAddToCBoxStatus;
1338var
1339 i: integer;
1340 x: string;
1341begin
1342 UpdatingGrid := False;
1343
1344 // ** detemine status of "add to" check boxes.....
1345
1346 //** if dx selected already exists in Problem or Personal Dx List then
1347 //** add to checkboxes are disabled.
1348 for i := 0 to lvDxGrid.Items.Count-1 do
1349 begin
1350 if lvDxGrid.Items[i].Selected then
1351 begin
1352 x:= lvDxGrid.Items[i].Subitems[1];
1353 lvDxGrid.Items[i].Selected := True;
1354 SetAddToCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]);
1355 lvDxGrid.SetFocus;
1356 end;
1357 end;
1358
1359 for i := 0 to lvDxGrid.Items.Count-1 do
1360 begin
1361 if lvDxGrid.Items[i].Selected then
1362 if lvDxGrid.Items[i].Caption = 'PL/PD' then
1363 begin
1364 UpdatingGrid := True;
1365 lvDxGrid.Items[i].Selected := True;
1366 cbaddToPL.Checked := True;
1367 cbAddToPDList.Checked := true;
1368 ResetCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]);
1369 lvDxGrid.SetFocus;
1370 end
1371 else if lvDxGrid.Items[i].Caption = 'PL' then
1372 begin
1373 UpdatingGrid := True;
1374 lvDxGrid.Items[i].Selected := True;
1375 cbaddToPL.Checked := True;
1376 cbAddToPDList.Checked := False;
1377 ResetCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]);
1378 lvDxGrid.SetFocus;
1379 end
1380 else if lvDxGrid.Items[i].Caption = 'PD' then
1381 begin
1382 UpdatingGrid := True;
1383 lvDxGrid.Items[i].Selected := True;
1384 cbaddToPL.Checked := False;
1385 cbAddToPDList.Checked := True;
1386 ResetCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]);
1387 lvDxGrid.SetFocus;
1388 end;
1389 end;
1390 // ** end determine check box status................
1391end;
1392
1393
1394procedure TfrmBALocalDiagnoses.lvDxGridKeyUp(Sender: TObject;
1395 var Key: Word; Shift: TShiftState);
1396begin
1397 inherited;
1398 selectingDX := False;
1399end;
1400
1401procedure TfrmBALocalDiagnoses.lvDxGridClick(Sender: TObject);
1402begin
1403 inherited;
1404if deleteDX then Exit;
1405
1406if lvDxGrid.SelCount > 1 then
1407 ProcessMultSelections
1408else
1409 SetAddToCBoxStatus;
1410end;
1411
1412procedure TfrmBALocalDiagnoses.lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1413var
1414 lstIndex: integer;
1415begin
1416 inherited;
1417 //** CQ4739
1418 with lbOrders do
1419 begin
1420 lstIndex := SendMessage(Handle, LB_ITEMFROMPOINT, 0, MakeLParam(X, Y));
1421 if (lstIndex >= 0) and (lstIndex <= Items.Count-1) then
1422 Hint := Items[lstIndex]
1423 else
1424 Hint := '';
1425 end;
1426 //** end CQ4739
1427end;
1428
1429procedure TfrmBALocalDiagnoses.SetAddToCheckBoxStatus(ADiagnosis:string);
1430var
1431 selectedDX :string;
1432 i: integer;
1433 begin
1434 if (cbAddToPL.Checked or cbAddToPDList.Checked) then
1435 begin
1436 for i := 0 to LvDxGrid.Items.Count-1 do
1437 begin
1438 if(lvDxGrid.Items[i].Selected) then
1439 begin
1440 if StrPos(PChar(LvDxGrid.Items[i].Caption),PChar(ADD_TO_PERSONAL_DX_LIST)) <> nil then Exit;
1441 if StrPos(PChar(LvDxGrid.Items[i].Caption),PChar(ADD_TO_PROBLEM_LIST)) <> nil then Exit;
1442 end;
1443 end;
1444 end;
1445
1446 if lvDxGrid.SelCount = 0 then
1447 begin
1448 ClearAndDisableCBoxes;
1449 Exit;
1450 end;
1451 selectedDX:= Piece(ADiagnosis,':',2);
1452 //** loop thru problem list dx, if match check box disabled
1453 if ProblemListDxFound(selectedDx) then
1454 begin
1455 cbAddToPL.Enabled := False;
1456 cbAddToPL.Checked := False;
1457 end
1458 else
1459 begin
1460 cbAddToPL.Enabled := True;
1461 cbAddToPL.Checked := False;
1462 end;
1463
1464 if PersonalListDxFound(selectedDx) then
1465 begin
1466 cbAddToPDList.Enabled := False;
1467 cbAddToPDList.Checked := False;
1468 end
1469 else
1470 begin
1471 cbAddToPDList.Enabled := True;
1472 cbAddToPDList.Checked := False;
1473 end;
1474
1475end;
1476
1477procedure TfrmBALocalDiagnoses.ProcessMultSelections;
1478var
1479 i: integer;
1480 selectedDX: string;
1481 PLFound, PDLFound: boolean;
1482begin
1483 PLFound := False;
1484 PDLFound := False;
1485 for i := 0 to lvDxGrid.Items.Count-1 do
1486 begin
1487 if(lvDxGrid.Items[i].Selected) then
1488 begin
1489 selectedDX := lvDxGrid.Items[i].Subitems[1];
1490 selectedDX := Piece(selectedDX,':',2);
1491 if not PLFound then
1492 PLFound := ProblemListDxFound(selectedDX);
1493 if not PDLFound then
1494 PDLFound := PersonalListDXFound(selectedDX);
1495 end;
1496 end;
1497 if not PDLFound then
1498 begin
1499 cbAddToPDList.Enabled := True;
1500 cbAddTOPDList.Checked := False;
1501 end
1502 else
1503 begin
1504 cbAddToPDList.Enabled := False;
1505 cbAddTOPDList.Checked := False;
1506 end;
1507 if not PLFound then
1508 begin
1509 cbAddToPL.Enabled := True;
1510 cbAddToPL.Checked := False;
1511 end
1512 else
1513 begin
1514 cbAddToPL.Enabled := False;
1515 cbAddToPL.Checked := False;
1516 end;
1517end;
1518
1519procedure TfrmBALocalDiagnoses.ClearAndDisableCBoxes;
1520begin
1521 cbAddToPL.Checked := False;
1522 cbAddToPDList.Checked := False;
1523 lvDxGrid.ClearSelection;
1524 cbAddToPL.Enabled := False;
1525 cbAddToPDList.Enabled := False;
1526end;
1527
1528procedure TfrmBALocalDiagnoses.ORStaticText1Enter(Sender: TObject);
1529begin
1530 inherited;
1531 (Sender as TORStaticText).Font.Style := [fsBold];
1532end;
1533
1534procedure TfrmBALocalDiagnoses.ORStaticText1Exit(Sender: TObject);
1535begin
1536 inherited;
1537 (Sender as TORStaticText).Font.Style := [];
1538end;
1539
1540procedure TfrmBALocalDiagnoses.ORStaticText3Enter(Sender: TObject);
1541begin
1542 inherited;
1543 (Sender as TORStaticText).Font.Style := [fsBold];
1544end;
1545
1546procedure TfrmBALocalDiagnoses.ORStaticText3Exit(Sender: TObject);
1547begin
1548 inherited;
1549 (Sender as TORStaticText).Font.Style := [];
1550end;
1551
1552procedure TfrmBALocalDiagnoses.ResetCheckBoxStatus(pDxCode:string);
1553begin
1554 if Not ProblemListDxFound(pDxCode) then
1555 cbAddToPL.Enabled := True;
1556 if Not PersonalListDxFound(pDxCode) then
1557 cbAddToPDList.Enabled := True;
1558
1559
1560end;
1561
1562
1563Initialization
1564 BADiagnosis := TStringList.Create;
1565 currentOrderIDList := TStringList.Create;
1566 ProblemDxHoldList := TStringList.Create;
1567 PersonalDxHoldList := TStringList.Create;
1568 lexIENHoldList := TStringList.Create;
1569 BADiagnosis.Clear;
1570 currentOrderIDList.Clear;
1571 PersonalDxHoldList.Clear;
1572 ProblemDxHoldList.Clear;
1573 lexIENHoldList.Clear;
1574
1575end.
1576
Note: See TracBrowser for help on using the repository browser.