Ignore:
Timestamp:
May 7, 2015, 12:34:29 PM (10 years ago)
Author:
healthsevak
Message:

Updating the working copy to CPRS version 28

Location:
cprs/trunk/CPRS-Chart/Encounter
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • cprs/trunk/CPRS-Chart/Encounter/fDiagnoses.pas

    r829 r1679  
    2525  private
    2626    procedure EnsurePrimaryDiag;
    27 
     27    function isProblem(diagnosis: TPCEDiag): Boolean;
     28    function isEncounterDx(problem: string): Boolean;
    2829  protected
    2930    procedure UpdateNewItemStr(var x: string); override;
     
    3839                     'via the Problems tab.';
    3940  TC_INACTIVE_CODE = 'Problem Contains Inactive Code';
     41  TX_REDUNDANT_DX  = 'The problem that you''ve selected is already included in the list of diagnoses' + #13#10 +
     42                     'for this encounter. No need to select it again...';
     43  TC_REDUNDANT_DX  = 'Redundant Diagnosis: ';
    4044
    4145var
     
    6569    if not Primary and (Items.Count > 0) then
    6670    begin
    67       GridIndex := 0;
    68       TPCEDiag(Items.Objects[0]).Primary := True;
     71      GridIndex := Items.Count - 1;//0; vhaispbellc CQ 15836
     72      TPCEDiag(Items.Objects[Items.Count - 1]).Primary := True;
    6973      GridChanged;
    7074    end;
     
    101105      if(lbGrid.Selected[i]) then
    102106        TPCEDiag(lbGrid.Items.Objects[i]).AddProb := (ckbDiagProb.Checked) and
     107                                                     (not isProblem(TPCEDiag(lbGrid.Items.Objects[i]))) and
    103108                                                     (TPCEDiag(lbGrid.Items.Objects[i]).Category <> PL_ITEMS);
    104109    GridChanged;
     
    130135  else
    131136    x := x + U + '0';
     137end;
     138
     139function TfrmDiagnoses.isProblem(diagnosis: TPCEDiag): Boolean;
     140var
     141  i: integer;
     142  p, code, narr, sct: String;
     143begin
     144  result := false;
     145  for i := 0 to FProblems.Count - 1 do
     146  begin
     147    p := FProblems[i];
     148    code := piece(p, '^', 1);
     149    narr := piece(p, '^', 2);
     150    if (pos('SCT', narr) > 0) or (pos('SNOMED', narr) > 0) then
     151      sct := piece(piece(piece(narr, ')', 1), '(', 2), ' ', 2)
     152    else
     153      sct := '';
     154    narr := TrimRight(piece(narr, '(',1));
     155    if pos(diagnosis.Code, code) > 0 then
     156    begin
     157      result := true;
     158      break;
     159    end
     160    else if (sct <> '') and (pos(sct, diagnosis.Narrative) > 0) then
     161    begin
     162      result := true;
     163      break;
     164    end
     165    else if pos(narr, diagnosis.Narrative) > 0 then
     166    begin
     167      result := true;
     168      break;
     169    end;
     170  end;
     171end;
     172
     173function TfrmDiagnoses.isEncounterDx(problem: string): Boolean;
     174var
     175  i: integer;
     176  dx, code, narr, pCode, pNarrative, sct: String;
     177
     178function getSCT(narr: string): string;
     179begin
     180  if (pos('SNOMED CT ', narr) > 0) then
     181    result := copy(narr, pos('SNOMED CT ', narr) + 10, length(narr))
     182  else
     183    result := '';
     184end;
     185
     186begin
     187  result := false;
     188  pCode := piece(problem, U, 1);
     189  pNarrative := piece(problem, U, 2);
     190  for i := 0 to lbGrid.Items.Count - 1 do
     191  begin
     192    dx := lbGrid.Items[i];
     193    narr := piece(dx, U, 3);
     194    code := piece(piece(copy(narr, pos('ICD-9-CM', narr), length(narr)), ' ', 2), ')', 1);
     195    sct := getSCT(piece(narr, ':', 1));
     196    if pos(pCode, narr) > 0 then
     197    begin
     198      result := true;
     199      break;
     200    end
     201    else if (sct <> '') and (pos(sct, pNarrative) > 0) then
     202    begin
     203      result := true;
     204      break;
     205    end
     206    else if pos(narr, pNarrative) > 0 then
     207    begin
     208      result := true;
     209      break;
     210    end;
     211  end;
    132212end;
    133213
     
    149229      if OK then
    150230        for k := 0 to lbGrid.Items.Count - 1 do
    151           if (lbGrid.Selected[k]) and (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) then
    152             PLItemCount := PLItemCount + 1;
     231        begin
     232          if (lbGrid.Selected[k]) then
     233          begin
     234            if (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) or isProblem(TPCEDiag(lbGrid.Items.Objects[k])) then
     235              PLItemCount := PLItemCount + 1;
     236          end;
     237        end;
    153238      OK := OK and (PLItemCount < lbGrid.SelCount);
    154239      ckbDiagProb.Enabled := OK;
     
    180265begin
    181266  inherited;
    182   if lbxSection.width = 0 then Exit;
    183   FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth);
     267  FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (10 * MainFontWidth) - ScrollBarWidth);
    184268  FSectionTabs[1] := -FSectionTabs[0]+2;
    185269  FSectionTabs[2] := -FSectionTabs[0]+4;
     
    190274  Index: Integer);
    191275begin
    192   if not FUpdatingGrid then
    193     if (lbxSection.Checked[Index]) and (Piece(lbxSection.Items[Index], U, 5) = '#') then
    194       begin
    195         InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
    196         lbxSection.Checked[Index] := False;
    197         exit;
    198       end;
     276  if (not FUpdatingGrid) and (lbxSection.Checked[Index]) then
     277  begin
     278    if (Piece(lbxSection.Items[Index], U, 5) = '#') then
     279    begin
     280      InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
     281      lbxSection.Checked[Index] := False;
     282      exit;
     283    end
     284    else if isEncounterDx(lbxSection.Items[Index]) then
     285    begin
     286      InfoBox(TX_REDUNDANT_DX, TC_REDUNDANT_DX + piece(lbxSection.Items[Index], '^',2),
     287        MB_ICONWARNING or MB_OK);
     288      lbxSection.Checked[Index] := False;
     289      exit;
     290    end;
     291  end;
    199292  inherited;
    200293  EnsurePrimaryDiag;
     
    220313  ADiagnosis: TPCEItem;
    221314begin
    222    inherited;
     315  inherited;
    223316  UBAGlobals.BAPCEDiagList.Clear;
    224317  with lbGrid do for i := 0 to Items.Count - 1 do
  • cprs/trunk/CPRS-Chart/Encounter/fEncVitals.pas

    r829 r1679  
    403403
    404404{== Vitals Lite 2004-05-21 ===================================================}
    405   if VitalsDLLHandle <> 0 then
    406   begin
    407     FreeLibrary(VitalsDLLHandle);
    408     VitalsDLLHandle := 0;
    409   end;
     405  UnloadVitalsDLL;
    410406{== Vitals Lite 2004-05-21 ===================================================}
    411407  inherited;
     
    429425
    430426procedure TfrmEncVitals.FormShow(Sender: TObject);
    431 var
    432   GMV_LibName: String;
    433427begin
    434428  inherited;
    435429  //Begin Vitals Lite
    436430  {Visit is Assumed to Be selected when Opening Encounter Dialog}
    437   GMV_LibName :='GMV_VitalsViewEnter.dll';
    438   GMV_LibName := GetProgramFilesPath + SHARE_DIR + GMV_LibName;
    439   if VitalsDLLHandle = 0 then
    440     VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
     431  LoadVitalsDLL;
    441432  if VitalsDLLHandle = 0 then // No Handle found
    442     MessageDLG('Can''t find library "'+GMV_LibName+'".',mtError,[mbok],0)
     433    MessageDLG('Can''t find library '+VitalsDLLName+'.',mtError,[mbok],0)
    443434  else
    444435    LoadVitalsList;
     
    619610  if assigned(VLPtVitals) then
    620611  begin
    621 //    frmFrame.DLLActive := True;  // need this flag for CCOW (RV)
    622612    VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false);
    623613    if assigned(VitalsList) then
     
    627617    MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0);
    628618  @VLPtVitals := nil;
    629 //  frmFrame.DLLActive := False;  // need this flag for CCOW (RV)
    630619end;
    631620//End Vitals Lite
  • cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.dfm

    r829 r1679  
    77  FormStyle = fsMDIForm
    88  OldCreateOrder = True
    9   Position = poScreenCenter
     9  Position = poMainFormCenter
    1010  OnCanResize = FormCanResize
    1111  OnClose = FormClose
  • cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.pas

    r829 r1679  
    400400
    401401    frmEncounterFrame.CreateChildForms(frmEncounterFrame, PCEData.Location);
     402    SetFormPosition(frmEncounterFrame);
    402403    ResizeAnchoredFormToFont(frmEncounterFrame);
    403     SetFormPosition(frmEncounterFrame);
     404    //SetFormPosition(frmEncounterFrame);
    404405
    405406    with frmEncounterFrame do
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBase.dfm

    r829 r1679  
    55  ClientHeight = 400
    66  ClientWidth = 624
     7  Position = poMainFormCenter
    78  OnClose = FormClose
    89  OnCreate = FormCreate
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.dfm

    r829 r1679  
    33  Top = 192
    44  Caption = 'frmPCEBaseGrid'
    5   ExplicitLeft = 128
    6   ExplicitTop = 192
    75  PixelsPerInch = 96
    86  TextHeight = 13
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.pas

    r829 r1679  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn,
     7  fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn, uPCE,
    88  VA508AccessibilityManager;
    99
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.dfm

    r829 r1679  
    33  Top = 166
    44  Caption = 'frmPCEBaseMain'
    5   ExplicitWidth = 320
    6   ExplicitHeight = 240
    75  PixelsPerInch = 96
    86  TextHeight = 13
     
    158156        Pieces = '3'
    159157        CheckEntireLine = True
    160         ExplicitLeft = -3
    161         ExplicitTop = -2
    162158      end
    163159      object btnOther: TButton
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.pas

    r829 r1679  
    6060    FPCECode: string;
    6161    FSplitterMove: boolean;
     62    FProblems: TStringList;
    6263    function GetCat: string;
    6364    procedure UpdateNewItemStr(var x: string); virtual;
     
    8687
    8788uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch, VA508AccessibilityRouter,
    88   ORCtrlsVA508Compatibility, fBase508Form;
     89  ORCtrlsVA508Compatibility, fBase508Form, UBAConst;
    8990
    9091{$R *.DFM}
     
    104105  CheckOffEntries;
    105106  FSectionPopulated := TRUE;
     107  if (lbSection.Items.Count > 0) then
     108    lblList.Caption := StringReplace(lbSection.DisplayText[lbSection.ItemIndex],
     109      '&', '&&', [rfReplaceAll] );
     110  if (lbSection.DisplayText[lbSection.ItemIndex] = DX_PROBLEM_LIST_TXT) then
     111    FastAssign(lbxSection.Items, FProblems);
    106112end;
    107113
     
    296302begin
    297303  inherited FormCreate(Sender);
     304  FProblems := TStringList.Create;
    298305  lbxSection.HideSelection := TRUE;
    299306  amgrMain.ComponentManager[lbSection] := TLBSectionManager.Create;
     
    301308
    302309procedure TfrmPCEBaseMain.FormDestroy(Sender: TObject);
    303 var
    304   i:integer;
    305 
    306 begin
    307   inherited;
    308   with lbGrid.Items do for i := 0 to Count - 1 do TPCEItem(Objects[i]).Free;
     310begin
     311  inherited;
     312  FProblems.Free;
    309313end;
    310314
  • cprs/trunk/CPRS-Chart/Encounter/fPCEEdit.pas

    r829 r1679  
    5050begin
    5151  Result := FALSE;
     52  (* agp moved from FormCreate to addrss a problem with editing an encounter without a note displaying in CPRS*)
     53  if uPatient <> Patient.DFN then
     54    begin
     55      KillObj(@uPCETemp);
     56      KillObj(@uPCETempOld);
     57    end;
     58  uPatient := Patient.DFN;
    5259  if (Encounter.VisitCategory = 'H') then
    5360  begin
     
    130137procedure TfrmPCEEdit.FormCreate(Sender: TObject);
    131138begin
     139  (* agp moved to EditPCEData procedure to addrss a problem
     140  with editing an encounter without a note displaying in CPRS
    132141  if uPatient <> Patient.DFN then
    133142    begin
     
    135144      KillObj(@uPCETempOld);
    136145    end;
    137   uPatient := Patient.DFN;
     146  uPatient := Patient.DFN;   *)
    138147end;
    139148
  • cprs/trunk/CPRS-Chart/Encounter/fPCELex.dfm

    r829 r1679  
    77  ClientHeight = 275
    88  ClientWidth = 429
    9   Position = poScreenCenter
     9  Position = poOwnerFormCenter
    1010  OnCreate = FormCreate
    11   ExplicitWidth = 320
    12   ExplicitHeight = 240
     11  ExplicitHeight = 307
    1312  PixelsPerInch = 96
    1413  TextHeight = 13
  • cprs/trunk/CPRS-Chart/Encounter/fProcedure.dfm

    r829 r1679  
    44  Caption = 'Encounter Procedure'
    55  ExplicitWidth = 632
    6   ExplicitHeight = 427
     6  ExplicitHeight = 434
    77  PixelsPerInch = 96
    88  TextHeight = 13
     
    9393  end
    9494  object spnProcQty: TUpDown [11]
    95     Left = 348
     95    Left = 353
    9696    Top = 371
    9797    Width = 15
     
    9999    Associate = txtProcQty
    100100    Min = 1
     101    Max = 999
    101102    Position = 1
    102103    TabOrder = 5
  • cprs/trunk/CPRS-Chart/Encounter/fVisitType.dfm

    r829 r1679  
    77  Constraints.MinWidth = 600
    88  OnCloseQuery = FormCloseQuery
    9   ExplicitLeft = 260
    109  ExplicitWidth = 600
    11   ExplicitHeight = 472
     10  ExplicitHeight = 465
    1211  PixelsPerInch = 96
    1312  TextHeight = 13
     
    193192      Align = alRight
    194193      TabOrder = 1
    195       ExplicitLeft = 384
     194      ExplicitLeft = 422
    196195      ExplicitWidth = 208
    197196      ExplicitHeight = 164
     
    256255        OnEnter = memSCDisplayEnter
    257256        Caption = 'Service Connection && Rated Disabilities'
     257        ExplicitWidth = 422
    258258      end
    259259    end
Note: See TracChangeset for help on using the changeset viewer.