Procedure

TfrmDiagnoses.lbxSectionClickCheck

Module

fDiagnoses

Last Modified

3/11/2015 8:41:48 AM

Visibility

Public/Published

Owner

TfrmDiagnoses

Declaration

procedure lbxSectionClickCheck(Sender: TObject; Index: Integer);

Calls Hierarchy


TfrmDiagnoses.lbxSectionClickCheck
 ├GetSearchString
 ├LexiconLookup
 │ ├TfrmBase508Form.Create
 │ │ ├TfrmBase508Form.UpdateAccessibilityActions
 │ │ ├UnfocusableControlEnter
 │ │ └AdjustControls
 │ │   ├TfrmBase508Form.ModifyUnfocusableControl
 │ │   └..(rec)..
 │ ├TEncounter.GetVisitCategory
 │ ├TfrmPCELex.ParseNarrCode
 │ ├TfrmPCELex.SetApp
 │ ├TfrmPCELex.SetDate
 │ └TfrmPCELex.SetICDVersion
 │   └TEncounter.GetICDVersion
 │     └FMNow
 ├TfrmDiagnoses.UpdateProblem
 │ ├EditLoad
 │ ├TProbRec.Create
 │ │ ├TProbRec.CreateFields
 │ │ ├TProbRec.LoadField
 │ │ │ └GetOrigVal
 │ │ └TProbRec.LoadComments
 │ │   └TComment.Create
 │ ├TKeyVal.DHCPtoKeyVal
 │ ├TEncounter.GetProviderName
 │ │ └TEncounter.UpdateText
 │ │   └GetEncounterText
 │ ├TProbRec.SetCodeDateStr
 │ │ └TProbRec.SetDateString
 │ │   └StrToFMDateTime
 │ ├EditSave
 │ └TProbRec.GetFilerObject
 │   ├TComment.TComtoDHCPCom
 │   │ └FixQuotes
 │   ├FixQuotes
 │   └TKeyVal.GetDHCPField
 ├TfrmDiagnoses.isEncounterDx
 │ └ExtractCode
 └TfrmDiagnoses.EnsurePrimaryDiag
   ├TfrmPCEBaseGrid.SetGridIndex
   │ └TfrmPCEBaseGrid.UpdateControls
   └TfrmPCEBaseMain.GridChanged
     ├TfrmPCEBaseMain.BeginUpdate
     ├TfrmPCEBaseGrid.SaveGridSelected
     ├TPCEItem.ItemStr
     ├TfrmPCEBaseGrid.RestoreGridSelected
     ├TfrmPCEBaseGrid.SyncGridData
     │ ├TfrmPCEBaseGrid.SaveGridSelected
     │ ├TfrmPCEBaseGrid.RestoreGridSelected
     │ └TfrmPCEBaseGrid.SyncGridHeader
     ├TfrmPCEBaseMain.EndUpdate
     └TfrmPCEBaseMain.UpdateControls
       ├TfrmPCEBaseMain.NotUpdating
       ├TfrmPCEBaseMain.BeginUpdate
       ├TfrmPCEBaseGrid.GetGridIndex
       └TfrmPCEBaseMain.EndUpdate

Calls

Name Declaration Comments
TfrmDiagnoses.EnsurePrimaryDiag procedure EnsurePrimaryDiag; -
GetSearchString function GetSearchString(AString: String): String; -
TfrmDiagnoses.isEncounterDx function isEncounterDx(problem: string): Boolean; -
LexiconLookup procedure LexiconLookup(var Code: string; ALexApp: Integer; ADate: TFMDateTime = 0; AExtend: Boolean = False; AInputString: String = ''; AMessage: String = ''; ADefaultToInput: Boolean = False); -
TfrmDiagnoses.UpdateProblem procedure UpdateProblem(AplIEN: String; AICDCode: String; ASCTCode: String = ''); -


Source

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;