source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBALocalDiagnoses.pas@ 809

Last change on this file since 809 was 541, checked in by Kevin Toppenberg, 15 years ago

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