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

Updating the working copy to CPRS version 28

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/fARTAllgy.pas

    r830 r1679  
    11unit fARTAllgy;
    2 
     2 
    33interface
    44
    … …  
    2121    lblAgent: TOROffsetLabel;
    2222    lstAllergy: TORListBox;
    23     btnAgent: TSpeedButton;
     23    btnAgent1: TSpeedButton;
    2424    lblOriginator: TOROffsetLabel;
    2525    cboOriginator: TORComboBox;
    … …  
    3333    calVerifyDate: TORDateBox;
    3434    lblVerifyDate: TOROffsetLabel;
    35     dlgReactionDateTime: TORDateTimeDlg;
    3635    Bevel1: TBevel;
    3736    lblSymptoms: TOROffsetLabel;
    … …  
    3938    lblSelectedSymptoms: TOROffsetLabel;
    4039    lstSelectedSymptoms: TORListBox;
    41     btnDateTime: TButton;
    4240    btnRemove: TButton;
    4341    grpObsHist: TRadioGroup;
    … …  
    6058    lblNatureOfReaction: TOROffsetLabel;
    6159    btnSevHelp: TORAlignButton;
    62     procedure btnAgentClick(Sender: TObject);
    63     procedure FormCreate(Sender: TObject);
     60    VA508ComponentAccessibility1: TVA508ComponentAccessibility;
     61    VA508ComponentAccessibility2: TVA508ComponentAccessibility;
     62    origlbl508: TVA508StaticText;
     63    origdtlbl508: TVA508StaticText;
     64    SymptomDateBox: TORDateBox;
     65    btnAgent: TButton;
     66    VA508ComponentAccessibility3: TVA508ComponentAccessibility;
     67    NoAllergylbl508: TVA508StaticText;
     68    procedure btnAgent1Click(Sender: TObject);
     69    procedure FormCreate(Sender: TObject);
    6470    procedure cboOriginatorNeedData(Sender: TObject; const StartFrom: String;
    6571      Direction, InsertAt: Integer);
    … …  
    7783    procedure btnRemoveClick(Sender: TObject);
    7884    procedure lstAllergyClick(Sender: TObject);
    79     procedure btnDateTimeClick(Sender: TObject);
    8085    procedure cboSymptomsMouseClick(Sender: TObject);
    8186    procedure cboSymptomsKeyDown(Sender: TObject; var Key: Word;
    … …  
    9095    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    9196    procedure btnSevHelpClick(Sender: TObject);
     97    procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
     98      var Text: string);
     99    procedure VA508ComponentAccessibility2ValueQuery(Sender: TObject;
     100      var Text: string);
     101    procedure VA508ComponentAccessibility2StateQuery(Sender: TObject;
     102      var Text: string);
     103    procedure VA508ComponentAccessibility2ItemInstructionsQuery(Sender: TObject;
     104      var Text: string);
     105    procedure VA508ComponentAccessibility2ItemQuery(Sender: TObject;
     106      var Item: TObject);
     107    procedure VA508ComponentAccessibility2InstructionsQuery(Sender: TObject;
     108      var Text: string);
     109    procedure VA508ComponentAccessibility2ComponentNameQuery(Sender: TObject;
     110      var Text: string);
     111    procedure VA508ComponentAccessibility2CaptionQuery(Sender: TObject;
     112      var Text: string);
     113    procedure SymptomDateBoxExit(Sender: TObject);
     114    procedure SymptomDateBoxDateDialogClosed(Sender: TObject);
     115    procedure calObservedDateExit(Sender: TObject);
     116    procedure VA508ComponentAccessibility3StateQuery(Sender: TObject;
     117      var Text: string);
     118    procedure memErrCmtsExit(Sender: TObject);
    92119  private
    93120    FLastAllergyID: string;
    … …  
    96123    FChanged: Boolean;
    97124    FOldHintPause : integer;
     125    procedure SetDate;
    98126  protected
    99127    procedure EnableDisableControls(EnabledStatus: boolean);
    … …  
    106134  end;
    107135
    108 function EnterEditAllergy(AllergyIEN: integer; AddNew, MarkAsEnteredInError: boolean): boolean;
     136function EnterEditAllergy(AllergyIEN: integer; AddNew, MarkAsEnteredInError: boolean; AnOwner: TComponent = nil; ARefNum: Integer = -1): boolean;
    109137function MarkEnteredInError(AllergyIEN: integer): boolean;
    110138function EnterNKAForPatient: boolean;
    111139
    112140var
     141  frmARTAllergy: TfrmARTAllergy;
    113142  AllergyList: TStringList;
    114143  OldRec, NewRec: TAllergyRec;
    115144  Defaults: TStringList;
    116145  Changing: Boolean;
     146  FAbort: Boolean;
    117147  uAddingNew: boolean = FALSE;
    118148  uEditing: Boolean = FALSE;
    … …  
    126156
    127157uses
    128   rODBase, uCore, rCore, rCover, fAllgyFind, fPtCWAD, fRptBox;
     158  rODBase, uCore, rCore, rCover, fCover, fAllgyFind, fPtCWAD, fRptBox, VA508AccessibilityRouter;
    129159
    130160const
    … …  
    183213end;
    184214
    185 function EnterEditAllergy(AllergyIEN: integer; AddNew, MarkAsEnteredInError: boolean): boolean;
    186 var
    187   frmARTAllergy: TfrmARTAllergy;
     215function EnterEditAllergy(AllergyIEN: integer; AddNew, MarkAsEnteredInError: boolean; AnOwner: TComponent = nil; ARefNum: Integer = -1): boolean;
     216var
    188217  Allergy: string;
    189 begin
     218begin     
     219  Result := False;
     220  if AnOwner = nil then AnOwner := Application;
     221 
     222  if frmARTAllergy <> nil then
     223  begin
     224    InfoBox('You are already entering/editing an Allergy.', 'Information', MB_OK);
     225    exit;
     226  end;
    190227  uAddingNew := AddNew;
    191228  uEditing := (not AddNew) and (not MarkAsEnteredInError);
    192229  uEnteredInError := MarkAsEnteredInError;
    193   Result := False;
    194   frmARTAllergy := TfrmARTAllergy.Create(Application);
     230  frmARTAllergy := TfrmARTAllergy.Create(AnOwner);
     231  if ARefNum <> -1 then frmARTAllergy.RefNum := ARefNum;
    195232  if frmARTAllergy.AbortAction then exit;
    196233  with frmARTAllergy do
    … …  
    228265              ckNoKnownAllergies.Checked := True;
    229266              Result := EnterNKAForPatient;
     267              frmARTAllergy.Close;
    230268              Exit;
    231269            end
    … …  
    253291        Exit;
    254292      end;
    255       ShowModal;
     293
     294      origlbl508.Caption := 'Originator. Read Only. Value is ' + cboOriginator.SelText;
     295      origdtlbl508.Caption := 'Origination Date. Read Only. Value is '+ calOriginated.Text;
     296      Show;
    256297      Result := FChanged;
    257298    finally
    258       uAddingNew := FALSE;
    259       uEditing := FALSE;
    260       uEnteredInError := FALSE;
    261       uUserCanVerify := FALSE;
    262       frmARTAllergy.Release;
     299//      uAddingNew := FALSE;
     300//      uEditing := FALSE;
     301//      uEnteredInError := FALSE;
     302//      uUserCanVerify := FALSE;
     303      //frmARTAllergy.Release;
    263304    end;
    264305end;
    … …  
    268309  inherited;       // what to do here?  How to set up dialog defaults without order dialog to supply prompts?
    269310  Changing := True;
     311  FAbort := True;
    270312  AbortAction := False;
    271313  AllergyList := TStringList.Create;
    … …  
    289331  StatusText('Initializing Long List');
    290332  ExtractItems(cboSymptoms.Items, Defaults, 'Top Ten');
    291   cboSymptoms.InsertSeparator;
     333  if ScreenReaderSystemActive then cboSymptoms.Items.Add('^----Separator for end of Top Ten signs and symptoms------')
     334  else cboSymptoms.InsertSeparator;
    292335  cboSymptoms.InitLongList('');
    293336  cboOriginator.InitLongList(User.Name) ;
    … …  
    306349var
    307350  Allergy: string;
     351  i: Integer;
    308352  //ErrMsg: string;
    309353begin
    … …  
    344388  ckChartMarked.Checked := ckChartMarked.Checked or uAddingNew;
    345389  ListAllergies(AllergyList);
     390  for i:=0 to grpObsHist.ControlCount -1 do
     391  TWinControl(grpObsHist.Controls[i]).TabStop := true;
    346392  with AllergyList do
    347393    if Count > 0 then
    348394      begin
    349395        if (Piece(Strings[0], U, 1) = '') and (Piece(Strings[0], U, 2) <> 'No Known Allergies') then
    350           ckNoKnownAllergies.Enabled := True
     396          begin
     397            ckNoKnownAllergies.Enabled := True;
     398            //TDP - CQ#19731 make sure NoAllergylbl508 is not enabled or visible if
     399            //      ckNoKnownAllergies is enabled
     400            NoAllergylbl508.Enabled := False;
     401            NoAllergylbl508.Visible := False;
     402          end
    351403        else
    352404          begin
    353405            ckNoKnownAllergies.Enabled := False;
    354406            btnCurrent.Enabled := True;
     407            //TDP - CQ#19731 make sure NoAllergylbl508 is enabled and visible if
     408            //      ckNoKnownAllergies is disabled
     409            if ScreenReaderSystemActive then
     410              begin
     411                NoAllergylbl508.Enabled := True;
     412                NoAllergylbl508.Visible := True;
     413              end;
    355414          end;
    356415      end
    … …  
    359418        btnCurrent.Enabled := False;
    360419        ckNoKnownAllergies.Enabled := True;
     420        //TDP - CQ#19731 make sure NoAllergylbl508 is not enabled or visible if
     421        //      ckNoKnownAllergies is enabled
     422        NoAllergylbl508.Enabled := False;
     423        NoAllergylbl508.Visible := False;
    361424      end;
    362425  if (not uEditing) and (not uEnteredInError) and (not uAddingNew) then
    … …  
    387450  Changing := False;
    388451  ControlChange(lstAllergy);
     452  origlbl508.Visible := False;
     453  origdtlbl508.Visible := False;
     454  if ScreenReaderSystemActive then
     455    begin
     456      origlbl508.Enabled := True;
     457      origdtlbl508.Enabled := True;
     458      origlbl508.Visible := True;
     459      origdtlbl508.Visible := True;
     460//    cboOriginator.Enabled := True;
     461//    calOriginated.Enabled := True;
     462//    calOriginated.ReadOnly := True;
     463    end;
     464end;
     465
     466procedure TfrmARTAllergy.SetDate;
     467var
     468  x: string;
     469begin
     470  Changing := True;
     471  with lstSelectedSymptoms do
     472    begin
     473      if (Items.Count = 0) or (ItemIndex = -1) or (not SymptomDateBox.IsValid) then exit;
     474
     475      if SymptomDateBox.FMDateTime > FMNow then
     476        InfoBox(TX_NO_FUTURE_DATES, TX_CAP_FUTURE, MB_OK)
     477      else
     478        begin
     479          x := Items[ItemIndex];
     480          x := ORFn.Pieces(x, U, 1, 2) + U + FloatToStr(SymptomDateBox.FMDateTime) + U +
     481                            FormatFMDateTime('mmm dd,yyyy@hh:nn', SymptomDateBox.FMDateTime);
     482          Items[ItemIndex] := x;
     483        end;
     484    end;
     485  Changing := False;
     486  ControlChange(SymptomDateBox);
    389487end;
    390488
    … …  
    437535      Changing := False;
    438536    end;
     537
     538end;
     539
     540procedure TfrmARTAllergy.VA508ComponentAccessibility1StateQuery(Sender: TObject;
     541  var Text: string);
     542begin
     543  inherited;
     544Text := 'Comments ' + memComments.Text;
     545end;
     546
     547procedure TfrmARTAllergy.VA508ComponentAccessibility2CaptionQuery(
     548  Sender: TObject; var Text: string);
     549begin
     550  inherited;
     551
     552 Text := 'Causative Agent';
     553end;
     554
     555procedure TfrmARTAllergy.VA508ComponentAccessibility2ComponentNameQuery(
     556  Sender: TObject; var Text: string);
     557begin
     558  inherited;
     559
     560 Text := 'List Box';
     561end;
     562
     563procedure TfrmARTAllergy.VA508ComponentAccessibility2InstructionsQuery(
     564  Sender: TObject; var Text: string);
     565begin
     566  //inherited;
     567
     568 Text := 'Read Only';
     569end;
     570
     571procedure TfrmARTAllergy.VA508ComponentAccessibility2ItemInstructionsQuery(
     572  Sender: TObject; var Text: string);
     573begin
     574  //inherited;
     575  Text := ' ';
     576end;
     577
     578procedure TfrmARTAllergy.VA508ComponentAccessibility2ItemQuery(Sender: TObject;
     579  var Item: TObject);
     580begin
     581  inherited;
     582 Text := ' ';
     583end;
     584
     585procedure TfrmARTAllergy.VA508ComponentAccessibility2StateQuery(Sender: TObject;
     586  var Text: string);
     587begin
     588//  inherited;
     589  Text := ' ';
     590end;
     591
     592procedure TfrmARTAllergy.VA508ComponentAccessibility2ValueQuery(Sender: TObject;
     593  var Text: string);
     594begin
     595  inherited;
     596  Text := Piece(lstAllergy.Items[0],U,2);
     597end;
     598
     599procedure TfrmARTAllergy.VA508ComponentAccessibility3StateQuery(Sender: TObject;
     600  var Text: string);
     601begin
     602  inherited;
     603  Text := memErrCmts.Text;
    439604end;
    440605
    … …  
    524689end;
    525690
     691procedure TfrmARTAllergy.calObservedDateExit(Sender: TObject);
     692var
     693  x: string;
     694begin
     695  inherited;
     696  calObservedDate.Validate(x);
     697  calObservedDate.FMDateTime := calObservedDate.FMDateTime;
     698end;
     699
    526700procedure TfrmARTAllergy.cboOriginatorNeedData(Sender: TObject;
    527701  const StartFrom: string; Direction, InsertAt: Integer);
    … …  
    542716  inherited;
    543717  Changing := True;
    544   cboSeverity.ItemIndex := -1;
     718  cboSeverity.ItemIndex := 1;
    545719  case grpObsHist.ItemIndex of
    546720    0:  begin
    … …  
    700874end;
    701875
    702 procedure TfrmARTAllergy.btnAgentClick(Sender: TObject);
     876procedure TfrmARTAllergy.memErrCmtsExit(Sender: TObject);
     877var
     878  AStringList: TStringList;
     879begin
     880  inherited;
     881  AStringList := TStringList.Create;
     882  try
     883    QuickCopy(memErrCmts, AStringList);
     884    LimitStringLength(AStringList, 74);
     885    QuickCopy(AstringList, memErrCmts);
     886    ControlChange(Self);
     887  finally
     888    AStringList.Free;
     889  end;
     890end;
     891
     892procedure TfrmARTAllergy.SymptomDateBoxDateDialogClosed(Sender: TObject);
     893begin
     894  inherited;
     895  SetDate;
     896end;
     897
     898procedure TfrmARTAllergy.SymptomDateBoxExit(Sender: TObject);
     899begin
     900  inherited;
     901  SetDate;
     902end;
     903
     904procedure TfrmARTAllergy.btnAgent1Click(Sender: TObject);
    703905var
    704906  Allergy: string;
    … …  
    756958  uDeletedSymptoms.Free;
    757959  AllergyList.Free;
     960  frmARTAllergy := NIL;
     961
     962  uAddingNew := FALSE;
     963  uEditing := FALSE;
     964  uEnteredInError := FALSE;
     965  uUserCanVerify := FALSE;
     966  frmCover.UpdateAllergiesList;
     967 
    758968  inherited;
    759969end;
    … …  
    7961006   lstAllergy.Enabled              := EnabledStatus;
    7971007   cboSymptoms.Enabled             := EnabledStatus;
    798    btnDateTime.Enabled             := EnabledStatus;
     1008   SymptomDateBox.Enabled          := EnabledStatus;
    7991009end;
    8001010
    … …  
    8121022          begin
    8131023            FChanged := False;
     1024            FAbort := False;
    8141025            Close;
    8151026            Exit;
    … …  
    8241035          Application.ProcessMessages;
    8251036        end;
     1037      FAbort := False;
    8261038      Close;
    8271039    end;
    … …  
    8831095end;
    8841096
    885 procedure TfrmARTAllergy.btnDateTimeClick(Sender: TObject);
    886 var
    887   AFMDateTime: TFMDateTime;
    888   x: string;
    889 begin
    890   inherited;
    891   Changing := True;
    892   with lstSelectedSymptoms do
    893     begin
    894       if (Items.Count = 0) or (ItemIndex = -1) then exit;
    895       AFMDateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 3));
    896       if AFMDateTime > 0 then
    897         dlgReactionDateTime.FMDateTime := AFMDateTime
    898       else
    899         dlgReactionDateTime.FMDateTime := FMNow;
    900       if not dlgReactionDateTime.Execute then exit;
    901       if dlgReactionDateTime.FMDateTime > FMNow then
    902         InfoBox(TX_NO_FUTURE_DATES, TX_CAP_FUTURE, MB_OK)
    903       else
    904         begin
    905           x := Items[ItemIndex];
    906           x := ORFn.Pieces(x, U, 1, 2) + U + FloatToStr(dlgReactionDateTime.FMDateTime) + U +
    907                             FormatFMDateTime('mmm dd,yyyy@hh:nn', dlgReactionDateTime.FMDateTime);
    908           Items[ItemIndex] := x;
    909         end;
    910     end;
    911   Changing := False;
    912   ControlChange(btnDateTime);
    913 end;
    914 
    9151097procedure TfrmARTAllergy.cboSymptomsMouseClick(Sender: TObject);
    9161098const
    … …  
    9841166
    9851167procedure TfrmARTAllergy.lstSelectedSymptomsChange(Sender: TObject);
     1168var
     1169  AFMDateTime: TFMDateTime;
    9861170begin
    9871171  inherited;
    9881172  with lstSelectedSymptoms do
    9891173    begin
    990       btnDateTime.Enabled := (ItemIndex <> -1);
    991       btnRemove.Enabled := btnDateTime.Enabled;
    992     end;
    993   //ControlChange(Self);
     1174      SymptomDateBox.Enabled := (ItemIndex <> -1);
     1175      btnRemove.Enabled := (ItemIndex <> -1);
     1176
     1177      if SymptomDateBox.Enabled then begin
     1178        AFMDateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 3));
     1179        if AFMDateTime > 0 then
     1180          SymptomDateBox.FMDateTime := AFMDateTime
     1181      end;
     1182    end;
    9941183end;
    9951184
    … …  
    10831272begin
    10841273  inherited;
     1274  Release;
    10851275  uEditing := False;
    10861276  uEnteredInError := False;
    … …  
    10881278  Application.HintHidePause := FOldHintPause;
    10891279  Action  := caFree;
     1280                 
    10901281end;
    10911282
    … …  
    10941285begin
    10951286  inherited;
     1287  if FAbort and frmARTAllergy.Visible then
     1288  begin
     1289    if InfoBox('Are you sure you want to cancel Entering/Editing this allergy?', 'Exiting Allergy Enter/Edit form', MB_YESNO) = ID_NO then
     1290    begin
     1291    CanClose := false;
     1292    exit;
     1293    end;
     1294  end;
    10961295  if AbortAction then exit;
    10971296end;
Note: See TracChangeset for help on using the changeset viewer.