Module

fDiagnoses

Path

C:\CPRS\CPRS30\Encounter\fDiagnoses.pas

Last Modified

3/11/2015 8:41:48 AM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmDiagnoses);

end.

Units Used in Interface

Name Comments
fPCEBase -
fPCEBaseMain -
UBAConst -
UBAGlobals -
uCore -
uPCE -

Units Used in Implementation

Name Comments
fEncounterFrame -
fPCELex -
rPCE -
rProbs -
UBACore -
uConst -
uProbs -

Classes

Name Comments
TfrmDiagnoses -

Procedures

Name Owner Declaration Scope Comments
btnOKClick TfrmDiagnoses procedure btnOKClick(Sender: TObject); override; Public/Published -
btnRemoveClick TfrmDiagnoses procedure btnRemoveClick(Sender: TObject); Public/Published -
ckbDiagProbClicked TfrmDiagnoses procedure ckbDiagProbClicked(Sender: TObject); Public/Published -
cmdDiagPrimaryClick TfrmDiagnoses procedure cmdDiagPrimaryClick(Sender: TObject); Public/Published -
EnsurePrimaryDiag TfrmDiagnoses procedure EnsurePrimaryDiag; Private -
FormCreate TfrmDiagnoses procedure FormCreate(Sender: TObject); Public/Published -
FormResize TfrmDiagnoses procedure FormResize(Sender: TObject); override; Public/Published -
GetEncounterDiagnoses TfrmDiagnoses procedure GetEncounterDiagnoses; Public/Published -
GetSCTforICD TfrmDiagnoses procedure GetSCTforICD(ADiagnosis: TPCEDiag); Private -
lbGridSelect TfrmDiagnoses procedure lbGridSelect(Sender: TObject); Public/Published -
lbSectionClick TfrmDiagnoses procedure lbSectionClick(Sender: TObject); Public/Published -
lbSectionDrawItem TfrmDiagnoses procedure lbSectionDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
lbxSectionClickCheck TfrmDiagnoses procedure lbxSectionClickCheck(Sender: TObject; Index: Integer); Public/Published -
lbxSectionDrawItem TfrmDiagnoses procedure lbxSectionDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
UpdateControls TfrmDiagnoses procedure UpdateControls; override; Protected -
UpdateNewItemStr TfrmDiagnoses procedure UpdateNewItemStr(var x: string); override; Protected -
UpdateProblem TfrmDiagnoses procedure UpdateProblem(AplIEN: String; AICDCode: String; ASCTCode: String = ''); Private -

Functions

Name Owner Declaration Scope Comments
ExtractCode - function ExtractCode(narr: String; csys: String): String; Local -
GetORCBBitmap - function GetORCBBitmap(Idx: TORCBImgIdx; BlackMode: boolean): TBitmap; Global -
GetSearchString - function GetSearchString(AString: String): String; Local -
isEncounterDx TfrmDiagnoses function isEncounterDx(problem: string): Boolean; Private -
isProblem TfrmDiagnoses function isProblem(diagnosis: TPCEDiag): Boolean; Private -

Global Variables

Name Type Declaration Comments
dxList TStringList dxList : TStringList; -
frmDiagnoses TfrmDiagnoses frmDiagnoses: TfrmDiagnoses; -
ORCBImages Array (static) ORCBImages: array[TORCBImgIdx, Boolean] of TBitMap; -

Constants

Name Declaration Scope Comments
BlackCheckBoxImageResNames array[TORCBImgIdx] of PChar = ( Global -
CheckBoxImageResNames array[TORCBImgIdx] of PChar = ( Global -
iiBlueQMark TORCBImgIdx Global -
iiChecked TORCBImgIdx Global -
iiDisChecked TORCBImgIdx Global -
iiDisGrayed TORCBImgIdx Global -
iiDisQMark TORCBImgIdx Global -
iiDisUnchecked TORCBImgIdx Global -
iiFlatChecked TORCBImgIdx Global -
iiFlatGrayed TORCBImgIdx Global -
iiFlatUnChecked TORCBImgIdx Global -
iiGrayed TORCBImgIdx Global -
iiQMark TORCBImgIdx Global -
iiRadioChecked TORCBImgIdx Global -
iiRadioDisChecked TORCBImgIdx Global -
iiRadioDisUnchecked TORCBImgIdx Global -
iiRadioUnchecked TORCBImgIdx Global -
iiUnchecked TORCBImgIdx Global -
PL_ITEMS 'Problem List Items' Global -
TC_I10_LACKS_SCT 'SNOMED CT Needed for Problem Entry' Interfaced -
TC_INACTIVE_CODE 'Problem Contains Inactive Code' Interfaced -
TC_INV_ICD10_DX 'Invalid Selection' Interfaced -
TC_NONSPEC_CODE 'Problem Contains Non-Specific Code' Interfaced -
TC_REDUNDANT_DX 'Redundant Diagnosis: ' Interfaced -
TX_ICD_LACKS_SCT_CODE 'Addition of a diagnosis to the problem list requires a SNOMED CT code. Please ' + Interfaced -
TX_INACTIVE_ICD_CODE 'This problem references an ICD code that is not active as of the date of this encounter. ' + Interfaced -
TX_INACTIVE_ICD_SCT_CODE 'This problem references BOTH an ICD and a SNOMED CT code that are not active as of the date ' + Interfaced -
TX_INACTIVE_SCT_CODE 'This problem references a SNOMED CT code that is not active as of the date of this encounter. ' + Interfaced -
TX_INV_ICD10_DX 'The selected ICD-10-CM diagnosis cannot be added to an encounter prior to ICD-10 implementation.' + CRLF + CRLF + Interfaced -
TX_NONSPEC_ICD_CODE 'Please enter a more specific ICD Diagnosis for this problem.' Interfaced -
TX_PROB_LACKS_SCT_CODE 'You''ve selected to update a problem from the Problem List which now requires a SNOMED CT code. ' + Interfaced -
TX_REDUNDANT_DX 'The problem that you''ve selected is already included in the list of diagnoses ' + Interfaced -


Module Source

1     unit fDiagnoses;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fPCEBase, StdCtrls, CheckLst, ORNet, ExtCtrls, Buttons, uPCE, ORFn,
8       ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, uCore, VA508AccessibilityManager,
9       ORCtrls;
10    
11    type
12      TfrmDiagnoses = class(TfrmPCEBaseMain)
13        cmdDiagPrimary: TButton;
14        ckbDiagProb: TCheckBox;
15        procedure cmdDiagPrimaryClick(Sender: TObject);
16        procedure ckbDiagProbClicked(Sender: TObject);
17        procedure FormCreate(Sender: TObject);
18        procedure btnRemoveClick(Sender: TObject);
19        procedure FormResize(Sender: TObject); override;
20        procedure lbxSectionClickCheck(Sender: TObject; Index: Integer);
21        procedure btnOKClick(Sender: TObject);  override;
22        procedure lbSectionClick(Sender: TObject);
23        procedure GetEncounterDiagnoses;
24        procedure lbSectionDrawItem(Control: TWinControl; Index: Integer;
25          Rect: TRect; State: TOwnerDrawState);
26        procedure lbxSectionDrawItem(Control: TWinControl; Index: Integer;
27          Rect: TRect; State: TOwnerDrawState);
28        procedure lbGridSelect(Sender: TObject);
29      private
30        procedure EnsurePrimaryDiag;
31        procedure GetSCTforICD(ADiagnosis: TPCEDiag);
32        procedure UpdateProblem(AplIEN: String; AICDCode: String; ASCTCode: String = '');
33        function isProblem(diagnosis: TPCEDiag): Boolean;
34        function isEncounterDx(problem: string): Boolean;
35      protected
36        procedure UpdateNewItemStr(var x: string); override;
37        procedure UpdateControls; override;
38      public
39      end;
40    
41    const
42      TX_INACTIVE_ICD_CODE     = 'This problem references an ICD code that is not active as of the date of this encounter. ' +
43                                 'Please update the ICD Diagnosis.';
44      TX_NONSPEC_ICD_CODE      = 'Please enter a more specific ICD Diagnosis for this problem.';
45      TX_INACTIVE_SCT_CODE     = 'This problem references a SNOMED CT code that is not active as of the date of this encounter. ' +
46                                 'Please update the SNOMED CT code.';
47      TX_INACTIVE_ICD_SCT_CODE = 'This problem references BOTH an ICD and a SNOMED CT code that are not active as of the date ' +
48                                 'of this encounter. Please update the codes now.';
49      TX_ICD_LACKS_SCT_CODE    = 'Addition of a diagnosis to the problem list requires a SNOMED CT code. Please ' +
50                                 'select the SNOMED CT concept which best describes the diagnosis.';
51      TX_PROB_LACKS_SCT_CODE   = 'You''ve selected to update a problem from the Problem List which now requires a SNOMED CT code. ' +
52                                 'Please enter a SNOMED CT equivalent term which best describes the diagnosis.';
53    
54      TC_INACTIVE_CODE         = 'Problem Contains Inactive Code';
55      TC_NONSPEC_CODE          = 'Problem Contains Non-Specific Code';
56      TC_I10_LACKS_SCT         = 'SNOMED CT Needed for Problem Entry';
57    
58      TX_REDUNDANT_DX          = 'The problem that you''ve selected is already included in the list of diagnoses ' +
59                                 'for this encounter. No need to select it again...';
60      TC_REDUNDANT_DX          = 'Redundant Diagnosis: ';
61    
62      TX_INV_ICD10_DX          = 'The selected ICD-10-CM diagnosis cannot be added to an encounter prior to ICD-10 implementation.' + CRLF + CRLF +
63                                 'Please select a valid ICD-9-CM diagnosis which best describes the diagnosis.';
64      TC_INV_ICD10_DX          = 'Invalid Selection';
65    
66    var
67      frmDiagnoses: TfrmDiagnoses;
68      dxList : TStringList;
69    
70    implementation
71    
72    {$R *.DFM}
73    
74    uses
75      fEncounterFrame, uConst, UBACore, VA508AccessibilityRouter, fPCELex, rPCE, uProbs, rProbs;
76    
77    type
78      TORCBImgIdx = (iiUnchecked, iiChecked, iiGrayed, iiQMark, iiBlueQMark,
79        iiDisUnchecked, iiDisChecked, iiDisGrayed, iiDisQMark,
80        iiFlatUnChecked, iiFlatChecked, iiFlatGrayed,
81        iiRadioUnchecked, iiRadioChecked, iiRadioDisUnchecked, iiRadioDisChecked);
82    
83    const
84      CheckBoxImageResNames: array[TORCBImgIdx] of PChar = (
85        'ORCB_UNCHECKED', 'ORCB_CHECKED', 'ORCB_GRAYED', 'ORCB_QUESTIONMARK',
86        'ORCB_BLUEQUESTIONMARK', 'ORCB_DISABLED_UNCHECKED', 'ORCB_DISABLED_CHECKED',
87        'ORCB_DISABLED_GRAYED', 'ORCB_DISABLED_QUESTIONMARK',
88        'ORLB_FLAT_UNCHECKED', 'ORLB_FLAT_CHECKED', 'ORLB_FLAT_GRAYED',
89        'ORCB_RADIO_UNCHECKED', 'ORCB_RADIO_CHECKED',
90        'ORCB_RADIO_DISABLED_UNCHECKED', 'ORCB_RADIO_DISABLED_CHECKED');
91    
92      BlackCheckBoxImageResNames: array[TORCBImgIdx] of PChar = (
93        'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED',
94        'BLACK_ORCB_QUESTIONMARK', 'BLACK_ORCB_BLUEQUESTIONMARK',
95        'BLACK_ORCB_DISABLED_UNCHECKED', 'BLACK_ORCB_DISABLED_CHECKED',
96        'BLACK_ORCB_DISABLED_GRAYED', 'BLACK_ORCB_DISABLED_QUESTIONMARK',
97        'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED',
98        'BLACK_ORCB_RADIO_UNCHECKED', 'BLACK_ORCB_RADIO_CHECKED',
99        'BLACK_ORCB_RADIO_DISABLED_UNCHECKED', 'BLACK_ORCB_RADIO_DISABLED_CHECKED');
100   
101     PL_ITEMS = 'Problem List Items';
102   
103   var
104     ORCBImages: array[TORCBImgIdx, Boolean] of TBitMap;
105   
106   function GetORCBBitmap(Idx: TORCBImgIdx; BlackMode: boolean): TBitmap;
107   var
108     ResName: string;
109   begin
110     if (not assigned(ORCBImages[Idx, BlackMode])) then
111     begin
112       ORCBImages[Idx, BlackMode] := TBitMap.Create;
113       if BlackMode then
114         ResName := BlackCheckBoxImageResNames[Idx]
115       else
116         ResName := CheckBoxImageResNames[Idx];
117       ORCBImages[Idx, BlackMode].LoadFromResourceName(HInstance, ResName);
118     end;
119     Result := ORCBImages[Idx, BlackMode];
120   end;
121   
122   procedure TfrmDiagnoses.EnsurePrimaryDiag;
123   var
124     i: Integer;
125     Primary: Boolean;
126   
127   begin
128     with lbGrid do
129     begin
130       Primary := False;
131       for i := 0 to Items.Count - 1 do
132         if TPCEDiag(Items.Objects[i]).Primary then
133           Primary := True;
134   
135       if not Primary and (Items.Count > 0) then
136       begin
137         GridIndex := Items.Count - 1;//0; zzzzzzbellc CQ 15836
138         TPCEDiag(Items.Objects[Items.Count - 1]).Primary := True;
139         GridChanged;
140       end;
141     end;
142   end;
143   
144   procedure TfrmDiagnoses.cmdDiagPrimaryClick(Sender: TObject);
145   var
146     gi, i: Integer;
147     ADiagnosis: TPCEDiag;
148   
149   begin
150     inherited;
151     gi := GridIndex;
152     with lbGrid do for i := 0 to Items.Count - 1 do
153     begin
154       ADiagnosis := TPCEDiag(Items.Objects[i]);
155       ADiagnosis.Primary := (gi = i);
156     end;
157     GridChanged;
158   end;
159   
160   procedure TfrmDiagnoses.ckbDiagProbClicked(Sender: TObject);
161   var
162     i: integer;
163   begin
164     inherited;
165     if(NotUpdating) then
166     begin
167       for i := 0 to lbGrid.Items.Count-1 do
168       begin
169         if(lbGrid.Selected[i]) then
170         begin
171           TPCEDiag(lbGrid.Items.Objects[i]).AddProb := (ckbDiagProb.Checked) and
172                                                        (not isProblem(TPCEDiag(lbGrid.Items.Objects[i]))) and
173                                                        (TPCEDiag(lbGrid.Items.Objects[i]).Category <> PL_ITEMS);
174           //TODO: Add check for I10Active
175           if TPCEDiag(lbGrid.Items.Objects[i]).AddProb and
176             (Piece(Encounter.GetICDVersion, U, 1) = '10D') and
177             (not ((pos('SCT', TPCEDiag(lbGrid.Items.Objects[i]).Narrative) > 0) or
178             (pos('SNOMED', TPCEDiag(lbGrid.Items.Objects[i]).Narrative) > 0))) then
179               GetSCTforICD(TPCEDiag(lbGrid.Items.Objects[i]));
180         end;
181       end;
182       GridChanged;
183     end;
184   end;
185   
186   procedure TfrmDiagnoses.FormCreate(Sender: TObject);
187   begin
188     inherited;
189     FTabName := CT_DiagNm;
190     FPCEListCodesProc := ListDiagnosisCodes;
191     FPCEItemClass := TPCEDiag;
192     FPCECode := 'POV';
193     FSectionTabCount := 3;
194     FormResize(Self);
195   end;
196   
197   procedure TfrmDiagnoses.btnRemoveClick(Sender: TObject);
198   begin
199     inherited;
200     Sync2Grid;
201     EnsurePrimaryDiag;
202   end;
203   
204   procedure TfrmDiagnoses.UpdateNewItemStr(var x: string);
205   begin
206     inherited;
207     if lbGrid.Items.Count = 0 then
208       x := x + U + '1'
209     else
210       x := x + U + '0';
211   end;
212   
213   procedure TfrmDiagnoses.UpdateProblem(AplIEN: String; AICDCode: String; ASCTCode: String = '');
214   var
215     AList: TStringList;
216     ProbRec: TProbRec;
217     CodeSysStr: String;
218   begin
219     // Update problem list entry with new ICD (& SCT) code(s) (& narrative).
220     AList := TStringList.create;
221     try
222       FastAssign(EditLoad(AplIEN, Encounter.Provider, User.StationNumber), AList) ;
223       ProbRec := TProbRec.Create(AList);
224       ProbRec.PIFN := AplIEN;
225   
226       if AICDCode <> '' then
227       begin
228         ProbRec.Diagnosis.DHCPtoKeyVal(Pieces(AICDCode, U, 1, 2));
229         CodeSysStr := Piece(AICDCode, U, 4);
230         if (Pos('10', CodeSysStr) > 0) then
231           CodeSysStr := '10D^ICD-10-CM'
232         else
233           CodeSysStr := 'ICD^ICD-9-CM';
234         ProbRec.CodeSystem.DHCPtoKeyVal(CodeSysStr);
235       end;
236   
237       if ASCTCode <> '' then
238       begin
239         ProbRec.SCTConcept.DHCPtoKeyVal(Pieces(ASCTCode, U, 1, 2));
240         //TODO: need to accommodate changes to Designation Code
241         ProbRec.Narrative.DHCPtoKeyVal(U + Piece(ASCTCode, U, 3));
242       end;
243   
244       ProbRec.RespProvider.DHCPtoKeyVal(IntToStr(Encounter.Provider) + u + Encounter.ProviderName);
245       ProbRec.CodeDateStr := FormatFMDateTime('mm/dd/yy', Encounter.DateTime);
246       AList.Clear;
247       FastAssign(EditSave(ProbRec.PIFN, User.DUZ, User.StationNumber, '1', ProbRec.FilerObject, ''), AList);
248     finally
249       AList.clear;
250     end;
251   end;
252   
253   function TfrmDiagnoses.isProblem(diagnosis: TPCEDiag): Boolean;
254   var
255     i: integer;
256     p, code, narr, sct: String;
257   begin
258     result := false;
259     for i := 0 to FProblems.Count - 1 do
260     begin
261       p := FProblems[i];
262       code := piece(p, '^', 1);
263       narr := piece(p, '^', 2);
264       if (pos('SCT', narr) > 0) or (pos('SNOMED', narr) > 0) then
265         sct := piece(piece(piece(narr, ')', 1), '(', 2), ' ', 2)
266       else
267         sct := '';
268       narr := TrimRight(piece(narr, '(',1));
269       if pos(diagnosis.Code, code) > 0 then
270       begin
271         result := true;
272         break;
273       end
274       else if (sct <> '') and (pos(sct, diagnosis.Narrative) > 0) then
275       begin
276         result := true;
277         break;
278       end
279       else if pos(narr, diagnosis.Narrative) > 0 then
280       begin
281         result := true;
282         break;
283       end;
284     end;
285   end;
286   
287   function TfrmDiagnoses.isEncounterDx(problem: string): Boolean;
288   var
289     i: integer;
290     dx, code, narr, pCode, pNarrative, sct: String;
291   
292   function ExtractCode(narr: String; csys: String): String;
293   var cso: Integer;
294   begin
295     if csys = 'SCT' then
296     begin
297       cso := 4;
298     end
299     else if (csys = 'ICD') and (pos('ICD-10', narr) > 0) then
300     begin
301       csys := 'ICD-10-CM';
302       cso := 10;
303     end
304     else
305     begin
306       csys := 'ICD-9-CM';
307       cso := 9;
308     end;
309     if (pos(csys, narr) > 0) then
310       result := Piece(copy(narr, pos(csys, narr) + cso, length(narr)), ')', 1)
311     else
312       result := '';
313   end;
314   
315   begin
316     result := false;
317     pCode := piece(problem, U, 1);
318     pNarrative := piece(problem, U, 2);
319     for i := 0 to lbGrid.Items.Count - 1 do
320     begin
321       dx := lbGrid.Items[i];
322       narr := piece(dx, U, 3);
323       code := ExtractCode(narr, 'ICD');
324       sct := ExtractCode(narr, 'SCT');
325       if pos(pCode, narr) > 0 then
326       begin
327         result := true;
328         break;
329       end
330       else if (sct <> '') and (pos(sct, pNarrative) > 0) then
331       begin
332         result := true;
333         break;
334       end
335       else if pos(narr, pNarrative) > 0 then
336       begin
337         result := true;
338         break;
339       end;
340     end;
341   end;
342   
343   procedure TfrmDiagnoses.UpdateControls;
344   var
345     i, j, k, PLItemCount: integer;
346     OK: boolean;
347   const
348     PL_ITEMS = 'Problem List Items';
349   begin
350     inherited;
351     if(NotUpdating) then
352     begin
353       BeginUpdate;
354       try
355         cmdDiagPrimary.Enabled := (lbGrid.SelCount = 1);
356         OK := (lbGrid.SelCount > 0);
357         PLItemCount := 0;
358         if OK then
359           for k := 0 to lbGrid.Items.Count - 1 do
360           begin
361             if (lbGrid.Selected[k]) then
362             begin
363               if (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) or isProblem(TPCEDiag(lbGrid.Items.Objects[k])) then
364                 PLItemCount := PLItemCount + 1;
365             end;
366           end;
367         OK := OK and (PLItemCount < lbGrid.SelCount);
368         ckbDiagProb.Enabled := OK;
369         if(OK) then
370         begin
371           j := 0;
372           for i := 0 to lbGrid.Items.Count-1 do
373           begin
374             if(lbGrid.Selected[i]) and (TPCEDiag(lbGrid.Items.Objects[i]).AddProb) then
375               inc(j);
376           end;
377           if(j = 0) then
378             ckbDiagProb.Checked := FALSE
379           else
380           if(j < lbGrid.SelCount) then
381             ckbDiagProb.State := cbGrayed
382           else
383             ckbDiagProb.Checked := TRUE;
384         end
385         else
386           ckbDiagProb.Checked := FALSE;
387       finally
388         EndUpdate;
389       end;
390     end;
391   end;
392   
393   procedure TfrmDiagnoses.FormResize(Sender: TObject);
394   begin
395     inherited;
396     FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (10 * MainFontWidth) - ScrollBarWidth);
397     FSectionTabs[1] := -FSectionTabs[0]+2;
398     FSectionTabs[2] := -FSectionTabs[0]+4;
399     UpdateTabPos;
400   end;
401   
402   procedure TfrmDiagnoses.lbxSectionClickCheck(Sender: TObject; Index: Integer);
403   var
404     ICDCode, ICDPar, SCTCode, SCTPar, plIEN, msg, SecItem, InputStr, OrigProbStr: String;
405   
406   function GetSearchString(AString: String): String;
407   begin
408     if (Pos('#', AString) > 0) then
409       Result := TrimLeft(Piece(AString, '#', 2))
410     else
411       Result := AString;
412   end;
413   
414   begin
415     if (not FUpdatingGrid) and (lbxSection.Checked[Index]) then
416     begin
417       SCTPar := '';
418       InputStr := '';
419       OrigProbStr := lbxSection.Items[Index];
420       if (Piece(lbxSection.Items[Index], U, 4) = '#') or
421          (Pos('799.9', Piece(lbxSection.Items[Index], U, 1)) > 0) or
422          (Pos('R69', Piece(lbxSection.Items[Index], U, 1)) > 0) then
423       begin
424         if (Piece(lbxSection.Items[Index], U, 4) = '#') then
425           msg := TX_INACTIVE_ICD_CODE
426         else
427           msg := TX_NONSPEC_ICD_CODE;
428   
429         InputStr := GetSearchString(Piece(lbxSection.Items[Index], U, 2));
430   
431         LexiconLookup(ICDCode, LX_ICD, 0, True, InputStr, msg);
432   
433         if (Piece(ICDCode, U, 1) <> '') then
434         begin
435           plIEN := Piece(lbxSection.Items[Index], U, 5);
436   
437           FUpdatingGrid := TRUE;
438           lbxSection.Items[Index] := Pieces(ICDCode, U, 1, 2) + U + Piece(ICDCode, U, 1) + U + plIEN;
439           lbxSection.Checked[Index] := True;
440           if plIEN <> '' then
441           begin
442             if not (Pos('SCT', Piece(ICDCode, U, 2)) > 0) and (Piece(Encounter.GetICDVersion, U, 1) = '10D') then
443             begin
444               //ask for SNOMED CT
445               LexiconLookup(SCTCode, LX_SCT, 0, True, InputStr, TX_PROB_LACKS_SCT_CODE);
446   
447               if (Piece(SCTCode, U, 3) <> '') then
448               begin
449                 SecItem := lbxSection.Items[Index];
450                 SetPiece(SecItem, U, 2, Piece(SCTCode, U, 2));
451   
452                 FUpdatingGrid := TRUE;
453                 lbxSection.Items[Index] := SecItem;
454                 lbxSection.Checked[Index] := True;
455                 if plIEN <> '' then
456                 begin
457                   SCTPar := Piece(SCTCode, U, 3) + U + Piece(SCTCode, U, 3) + U + Piece(SCTCode, U, 2);
458                 end;
459                 FUpdatingGrid := FALSE;
460               end
461               else
462               begin
463                 //Undo previous ICD-10 updates when cancelling out of the SCT update dialog
464                 lbxSection.Items[Index] := OrigProbStr;
465                 lbxSection.Checked[Index] := False;
466                 FUpdatingGrid := False;
467                 exit;
468               end;
469             end;
470             ICDPar := Piece(ICDCode, U, 3) + U + Piece(ICDCode, U, 1) + U + Piece(ICDCode, U, 2) + U + Piece(ICDCode, U, 4);
471             UpdateProblem(plIEN, ICDPar, SCTPar);
472           end;
473           FUpdatingGrid := FALSE;
474         end
475         else
476         begin
477           lbxSection.Checked[Index] := False;
478           exit;
479         end;
480       end
481       else if (Piece(lbxSection.Items[Index], U, 4) = '$') then
482       begin
483         // correct inactive SCT Code
484         msg := TX_INACTIVE_SCT_CODE;
485   
486         LexiconLookup(SCTCode, LX_SCT, 0, True, InputStr, msg);
487   
488         if (Piece(SCTCode, U, 3) <> '') then
489         begin
490           plIEN := Piece(lbxSection.Items[Index], U, 5);
491   
492           SecItem := lbxSection.Items[Index];
493           SetPiece(SecItem, U, 2, Piece(SCTCode, U, 2));
494   
495           FUpdatingGrid := TRUE;
496           lbxSection.Items[Index] := SecItem;
497           lbxSection.Checked[Index] := True;
498           if plIEN <> '' then
499           begin
500             SCTPar := Piece(SCTCode, U, 3) + U + Piece(SCTCode, U, 3) + U + Piece(SCTCode, U, 2);
501             UpdateProblem(plIEN, '', SCTPar);
502           end;
503           FUpdatingGrid := FALSE;
504         end
505         else
506         begin
507           lbxSection.Checked[Index] := False;
508           exit;
509         end;
510       end
511       else if (Piece(lbxSection.Items[Index], U, 4) = '#$') then
512       begin
513         // correct inactive SCT Code
514         msg := TX_INACTIVE_SCT_CODE;
515   
516         LexiconLookup(SCTCode, LX_SCT, 0, True, InputStr, msg);
517   
518         if (Piece(SCTCode, U, 3) = '') then
519         begin
520           lbxSection.Checked[Index] := False;
521           exit;
522         end;
523   
524         // correct inactive ICD Code
525         msg := TX_INACTIVE_ICD_CODE;
526   
527         LexiconLookup(ICDCode, LX_ICD, 0, True, '', msg);
528   
529         if (Piece(ICDCode, U, 1) <> '') and (Piece(SCTCode, U, 3) <> '') then
530         begin
531           plIEN := Piece(lbxSection.Items[Index], U, 5);
532   
533           SetPiece(ICDCode, U, 2, Piece(SCTCode, U, 2));
534   
535           FUpdatingGrid := TRUE;
536           lbxSection.Items[Index] := Pieces(ICDCode, U, 1, 2) + U + Piece(ICDCode, U, 1) + U + plIEN;
537           lbxSection.Checked[Index] := True;
538           if plIEN <> '' then
539           begin
540             SCTPar := Piece(SCTCode, U, 3) + U + Piece(SCTCode, U, 3) + U + Piece(SCTCode, U, 2);
541             ICDPar := Piece(ICDCode, U, 3) + U + Piece(ICDCode, U, 1) + U + Piece(ICDCode, U, 2) + U + Piece(ICDCode, U, 4);
542             UpdateProblem(plIEN, ICDPar, SCTPar);
543           end;
544           FUpdatingGrid := FALSE;
545         end
546         else
547         begin
548           lbxSection.Checked[Index] := False;
549           exit;
550         end;
551       end
552       else if (Piece(lbSection.Items[lbSection.ItemIndex], U, 2) = PL_ITEMS) and
553         (Piece(Encounter.GetICDVersion, U, 1) = '10D') and
554         not (Pos('SCT', Piece(lbxSection.Items[Index], U, 2)) > 0) then
555       begin
556         // Problem Lacks SCT Code
557         msg := TX_PROB_LACKS_SCT_CODE;
558   
559         LexiconLookup(SCTCode, LX_SCT, 0, True, InputStr, msg);
560   
561         if (Piece(SCTCode, U, 3) <> '') then
562         begin
563           plIEN := Piece(lbxSection.Items[Index], U, 5);
564   
565           SecItem := lbxSection.Items[Index];
566           SetPiece(SecItem, U, 2, Piece(SCTCode, U, 2));
567   
568           FUpdatingGrid := TRUE;
569           lbxSection.Items[Index] := SecItem;
570           lbxSection.Checked[Index] := True;
571           if plIEN <> '' then
572           begin
573             SCTPar := Piece(SCTCode, U, 3) + U + Piece(SCTCode, U, 3) + U + Piece(SCTCode, U, 2);
574             UpdateProblem(plIEN, '', SCTPar);
575           end;
576           FUpdatingGrid := FALSE;
577         end
578         else
579         begin
580           lbxSection.Checked[Index] := False;
581           exit;
582         end;
583       end
584       else if (Piece(Encounter.GetICDVersion, U, 1) = 'ICD') and
585         ((Pos('ICD-10', Piece(lbxSection.Items[Index], U, 2)) > 0) or (Piece(lbxSection.Items[Index], U, 6)='10D')) then
586       begin
587         // Attempting to add an ICD10 diagnosis code to an ICD9 encounter
588         InfoBox(TX_INV_ICD10_DX, TC_INV_ICD10_DX, MB_ICONERROR or MB_OK);
589         lbxSection.Checked[Index] := False;
590         exit;
591       end
592       else if isEncounterDx(lbxSection.Items[Index]) then
593       begin
594         InfoBox(TX_REDUNDANT_DX, TC_REDUNDANT_DX + piece(lbxSection.Items[Index], '^',2),
595           MB_ICONWARNING or MB_OK);
596         lbxSection.Checked[Index] := False;
597         exit;
598       end;
599     end;
600     inherited;
601     EnsurePrimaryDiag;
602   end;
603   
604   procedure TfrmDiagnoses.lbxSectionDrawItem(Control: TWinControl; Index: Integer;
605     Rect: TRect; State: TOwnerDrawState);
606   var
607     Narr, Code: String;
608     Format, CodeTab, ItemRight, DY: Integer;
609     ARect, TmpR: TRect;
610     BMap: TBitMap;
611   begin
612     inherited;
613     Narr := Piece((Control as TORListBox).Items[Index], U, 2);
614     Code := Piece((Control as TORListBox).Items[Index], U, 3);
615     CodeTab := StrToInt(Piece(lbxSection.TabPositions, ',', 2));
616   
617     // draw CheckBoxes
618     with lbxSection do
619     begin
620       if (CheckBoxes) then
621       begin
622         case CheckedState[Index] of
623           cbUnchecked:
624           begin
625             if (FlatCheckBoxes) then
626               BMap := GetORCBBitmap(iiFlatUnChecked, False)
627             else
628               BMap := GetORCBBitmap(iiUnchecked, False);
629           end;
630           cbChecked:
631           begin
632             if (FlatCheckBoxes) then
633               BMap := GetORCBBitmap(iiFlatChecked, False)
634             else
635               BMap := GetORCBBitmap(iiChecked, False);
636           end;
637         else // cbGrayed:
638         begin
639           if (FlatCheckBoxes) then
640             BMap := GetORCBBitmap(iiFlatGrayed, False)
641           else
642             BMap := GetORCBBitmap(iiGrayed, False);
643           end;
644         end;
645         TmpR := Rect;
646         TmpR.Right := TmpR.Left;
647         dec(TmpR.Left, (LBCheckWidthSpace - 5));
648         DY := ((TmpR.Bottom - TmpR.Top) - BMap.Height) div 2;
649         Canvas.Draw(TmpR.Left, TmpR.Top + DY, BMap);
650       end;
651     end;
652   
653     // draw the Problem Text
654     ARect := (Control as TListBox).ItemRect(Index);
655     ARect.Left := ARect.Left + LBCheckWidthSpace;
656     ItemRight := ARect.Right;
657     ARect.Right := CodeTab - 10;
658     Format := (DT_LEFT or DT_NOPREFIX or DT_WORD_ELLIPSIS);
659     DrawText((Control as TListBox).Canvas.Handle, PChar(Narr), Length(Narr), ARect, Format);
660   
661     // now draw ICD codes
662     ARect.Left := CodeTab;
663     ARect.Right := ItemRight;
664     DrawText((Control as TListBox).Canvas.Handle, PChar(Code), Length(Code), ARect, Format);
665   end;
666   
667   procedure TfrmDiagnoses.btnOKClick(Sender: TObject);
668   begin
669     inherited;
670     if  BILLING_AWARE then
671        GetEncounterDiagnoses;
672   end;
673   
674   procedure TfrmDiagnoses.lbGridSelect(Sender: TObject);
675   begin
676     inherited;
677     Sync2Grid;
678   end;
679   
680   procedure TfrmDiagnoses.lbSectionClick(Sender: TObject);
681   begin
682     inherited;
683   //
684   end;
685   
686   procedure TfrmDiagnoses.GetEncounterDiagnoses;
687   var
688     i: integer;
689     dxCode, dxName: string;
690     ADiagnosis: TPCEItem;
691   begin
692     inherited;
693     UBAGlobals.BAPCEDiagList.Clear;
694     with lbGrid do for i := 0 to Items.Count - 1 do
695     begin
696       ADiagnosis := TPCEDiag(Items.Objects[i]);
697       dxCode :=  ADiagnosis.Code;
698       dxName :=  ADiagnosis.Narrative;
699       if BAPCEDiagList.Count = 0 then
700          UBAGlobals.BAPCEDiagList.Add(U + DX_ENCOUNTER_LIST_TXT);
701       UBAGlobals.BAPCEDiagList.Add(dxCode + U + dxName);
702     end;
703   end;
704   
705   procedure TfrmDiagnoses.GetSCTforICD(ADiagnosis: TPCEDiag);
706   var
707     Code: String;
708   begin
709     // look-up SNOMED CT
710     LexiconLookup(Code, LX_SCT, 0, False, ADiagnosis.Narrative, TX_ICD_LACKS_SCT_CODE);
711     if (Code = '') then
712     begin
713       ckbDiagProb.Checked := False;
714     end
715     else
716     begin
717       ADiagnosis.Narrative := Piece(Code, U, 2);
718     end;
719   end;
720   
721   procedure TfrmDiagnoses.lbSectionDrawItem(Control: TWinControl;
722     Index: Integer; Rect: TRect; State: TOwnerDrawState);
723   begin
724     inherited;
725     if (control as TListbox).items[index] = DX_PROBLEM_LIST_TXT then
726        (Control as TListBox).Canvas.Font.Style := [fsBold]
727     else
728        if (control as Tlistbox).items[index] = DX_PERSONAL_LIST_TXT then
729           (Control as TListBox).Canvas.Font.Style := [fsBold]
730     else
731        if (control as Tlistbox).items[index] =  DX_TODAYS_DX_LIST_TXT  then
732           (Control as TListBox).Canvas.Font.Style := [fsBold]
733     else
734        if (control as Tlistbox).items[index] = DX_ENCOUNTER_LIST_TXT then
735           (Control as TListBox).Canvas.Font.Style := [fsBold]
736     else
737        (Control as TListBox).Canvas.Font.Style := [];
738   
739     (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as
740                 TListBox).Items[Index]); {display the text }
741   end;
742   
743   initialization
744     SpecifyFormIsNotADialog(TfrmDiagnoses);
745   
746   end.

Module Calls (2 levels)


fDiagnoses
 ├fPCEBase
 │ ├uConst
 │ ├fAutoSz
 │ ├fBase508Form
 │ └fEncounterFrame
 ├uPCE
 │ ├uConst
 │ ├uCore
 │ ├rPCE
 │ ├rCore
 │ ├rTIU
 │ ├fEncounterFrame...
 │ ├uVitals
 │ ├fFrame
 │ ├fPCEProvider
 │ └rVitals
 ├fPCEBaseMain
 │ ├fPCEBaseGrid
 │ ├rPCE...
 │ ├uPCE...
 │ ├fPCELex
 │ ├fPCEOther
 │ ├fEncounterFrame...
 │ ├fHFSearch
 │ ├fBase508Form...
 │ └UBAConst
 ├UBAGlobals
 │ ├uConst
 │ ├rOrders
 │ ├fBALocalDiagnoses
 │ ├fOrdersSign
 │ ├fReview
 │ ├uCore...
 │ ├rCore...
 │ ├UBAConst
 │ └UBACore
 ├UBAConst
 ├uCore...
 ├fEncounterFrame...
 ├uConst
 ├fPCELex...
 ├rPCE...
 ├uProbs
 │ ├uConst
 │ ├rCore...
 │ └uCore...
 └rProbs
   └uCore...

Module Called-By (2 levels)


       fDiagnoses
fEncounterFrame┘ 
         uPCE┤   
         rPCE┤   
     fPCEBase┤   
   fVisitType┤   
fDiagnoses...┤   
 fPCEBaseMain┤   
   fProcedure┤   
    fPCEOther┤   
fImmunization┤   
    fSkinTest┤   
   fPatientEd┤   
fHealthFactor┤   
        fExam┤   
   fEncVitals┤   
       fNotes┤   
    fConsults┤   
      fDCSumm┤   
     fSurgery┤   
         fGAF┤   
     fPCEEdit┤   
    fHFSearch┘