source: cprs/trunk/CPRS-Chart/BA/fBALocalDiagnoses.pas@ 1724

Last change on this file since 1724 was 1679, checked in by healthsevak, 10 years ago

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