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

Last change on this file since 1582 was 829, checked in by Kevin Toppenberg, 14 years ago

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