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

Updating the working copy to CPRS version 28

Location:
cprs/trunk/CPRS-Chart/Consults
Files:
15 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm

    r829 r1679  
    44  BorderIcons = []
    55  Caption = 'frmConsultAction'
    6   ClientHeight = 379
     6  ClientHeight = 429
    77  ClientWidth = 592
    88  Constraints.MinHeight = 406
    … …  
    1010  OldCreateOrder = True
    1111  Position = poScreenCenter
     12  ExplicitWidth = 600
     13  ExplicitHeight = 456
    1214  PixelsPerInch = 96
    1315  TextHeight = 13
    … …  
    1618    Top = 0
    1719    Width = 592
    18     Height = 379
     20    Height = 429
    1921    Align = alClient
    2022    BevelOuter = bvNone
    2123    TabOrder = 0
     24    ExplicitHeight = 379
    2225    object pnlForward: TPanel
    2326      Left = 0
    2427      Top = 0
    2528      Width = 224
    26       Height = 379
     29      Height = 429
    2730      Align = alLeft
    2831      BevelOuter = bvNone
    2932      TabOrder = 0
     33      ExplicitHeight = 379
    3034      object lblToService: TOROffsetLabel
    3135        Left = 2
    … …  
    170174      Top = 0
    171175      Width = 368
    172       Height = 379
     176      Height = 429
    173177      Align = alClient
    174178      BevelOuter = bvNone
    175179      TabOrder = 1
     180      ExplicitHeight = 379
    176181      object pnlSigFind: TPanel
    177182        Left = 0
    … …  
    202207        Top = 57
    203208        Width = 368
    204         Height = 224
     209        Height = 274
    205210        Align = alClient
    206211        Alignment = taLeftJustify
    207212        BevelOuter = bvNone
    208213        TabOrder = 1
     214        ExplicitHeight = 224
    209215        object lblComments: TOROffsetLabel
    210216          Left = 0
    … …  
    223229          Top = 19
    224230          Width = 368
    225           Height = 170
     231          Height = 220
    226232          Align = alClient
    227233          Font.Charset = ANSI_CHARSET
    … …  
    234240          TabOrder = 0
    235241          Caption = 'Comments'
     242          ExplicitHeight = 170
    236243        end
    237244        object pnlAlert: TPanel
    238245          Left = 0
    239           Top = 189
     246          Top = 239
    240247          Width = 368
    241248          Height = 35
    … …  
    243250          BevelOuter = bvNone
    244251          TabOrder = 1
     252          ExplicitTop = 189
    245253          object lblAutoAlerts: TStaticText
    246254            Left = 6
    … …  
    263271      object pnlAllActions: TPanel
    264272        Left = 0
    265         Top = 281
     273        Top = 331
    266274        Width = 368
    267275        Height = 98
    … …  
    269277        BevelOuter = bvNone
    270278        TabOrder = 2
     279        ExplicitTop = 281
    271280        DesignSize = (
    272281          368

  • cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas

    r829 r1679  
    153153  i: integer;
    154154  OrdItmIEN: integer;
     155  attention: string;                                                              //wat cq 15561
     156  AList: TStringList;                                                             {WAT cq 19626}
    155157begin
    156158 pnlSigFind.Visible := False;
    … …  
    158160 pnlComments.Visible := True;
    159161 memComments.Clear;
     162 AList := TStringList.Create;
     163try                                                                               {WAT cq 19626}
    160164 if IsProcedure then
    161165   begin
    … …  
    183187 else
    184188   begin
    185      SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
     189     FastAssign(SvcList, AList);                                                  {WAT cq 19626}
     190     SortByPiece(AList, U, 2);                                                    {WAT cq 19626}
     191     //SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
    186192     for i := 0 to SvcList.Count - 1 do
    187193        if (cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1) and   {RV}
    … …  
    200206             end ;
    201207       end;
    202      pnlForward.Visible := True ;       
     208     pnlForward.Visible := True ;
    203209   end ;
    204210 if cboService.Items.Count = 1 then cboService.ItemIndex := 0;
    205211 FToService := cboService.ItemIEN;
    206  cboAttentionOf.InitLongList('') ;
     212 //wat cq 15561
     213 //cboAttentionOf.InitLongList('') ;
     214 FAttentionOf := ConsultRec.Attention;
     215 attention := ExternalName(FAttentionOf,200);
     216 cboAttentionOf.InitLongList(attention);
     217 cboAttentionOf.SelectByIEN(FAttentionOf);
     218 //end cq 15561
    207219 with cboUrgency do
    208220  begin
    … …  
    224236  cboPerson.OnNeedData := NewPersonNeedData;         //
    225237  cboPerson.InitLongList(User.Name)  ;
    226   cboPerson.SelectByIEN(User.DUZ);       
     238  cboPerson.SelectByIEN(User.DUZ);
    227239  ckAlert.Visible := False ;
    228240  lblAutoAlerts.Visible := False;
    229241  Result := True;
     242finally
     243  AList.Free;                                                                      {WAT cq 19626}
     244end;
    230245end;
    231246
    … …  
    601616begin
    602617  case FUserLevel of
    603     UL_NONE, UL_REVIEW:
    604       begin
    605         if FUserIsRequester then
    606           x := TX_ALERT1 + TX_ALERT_SVC_USERS
    607         else
    608           x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
    609       end;
    610     UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN:
    611       begin
    612         if FUserIsRequester then
    613           //x := TX_ALERT_NOBODY   Replace with following line
    614           x := TX_ALERT1 + TX_ALERT_SVC_USERS
    615         else
    616           x := TX_ALERT1 + TX_ALERT_PROVIDER + '.';
    617       end;
    618     UL_UNRESTRICTED:
    619       begin
    620         if FUserIsRequester then
    621           x := TX_ALERT1 + TX_ALERT_SVC_USERS
    622         else
    623           x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
    624       end;
    625   end;
    626   lblAutoAlerts.Caption := x;
     618     UL_NONE, UL_REVIEW:
     619       begin
     620         if FUserIsRequester then
     621           x := TX_ALERT1 + TX_ALERT_SVC_USERS
     622         else
     623           x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
     624       end;
     625     UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN:
     626       begin
     627         if FUserIsRequester then
     628           //x := TX_ALERT_NOBODY   Replace with following line
     629            x := TX_ALERT1 + TX_ALERT_SVC_USERS
     630         else
     631           x := TX_ALERT1 + TX_ALERT_PROVIDER + '.';
     632       end;
     633     UL_UNRESTRICTED:
     634       begin
     635         if FUserIsRequester then
     636           x := TX_ALERT1 + TX_ALERT_SVC_USERS
     637         else
     638           x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
     639       end;
     640   end;
     641   lblAutoAlerts.Caption := x;
    627642end;
    628643

  • cprs/trunk/CPRS-Chart/Consults/fConsults.dfm

    r829 r1679  
    1111  OnShow = FormShow
    1212  ExplicitWidth = 723
    13   ExplicitHeight = 467
     13  ExplicitHeight = 475
    1414  PixelsPerInch = 96
    1515  TextHeight = 13
    … …  
    661661      OnClick = cmdPCEClick
    662662    end
     663    object popNoteMemoViewCslt: TMenuItem
     664      Caption = 'View Consult Details'
     665      ShortCut = 24661
     666      OnClick = popNoteMemoViewCsltClick
     667    end
    663668  end
    664669  object popConsultList: TPopupMenu

  • cprs/trunk/CPRS-Chart/Consults/fConsults.pas

    r829 r1679  
    180180    imgLblImages: TVA508ImageListLabeler;
    181181    imgLblConsults: TVA508ImageListLabeler;
     182    popNoteMemoViewCslt: TMenuItem;   //wat cq 17586
    182183    procedure mnuChartTabClick(Sender: TObject);
    183184    procedure lstConsultsClick(Sender: TObject);
    … …  
    285286    procedure cmdEditResubmitExit(Sender: TObject);
    286287    procedure cmdNewConsultExit(Sender: TObject);
     288    procedure popNoteMemoViewCsltClick(Sender: TObject);   //wat cq 17586
    287289  private
    288290    FocusToRightPanel : Boolean;
    … …  
    348350    function UserIsSigner(NoteIEN: integer): boolean;
    349351  public
     352    function CustomCanFocus(Control: TWinControl): Boolean; //CB
     353    function LinesVisible(richedit: Trichedit): integer; //CB
    350354    function ActiveEditOf(AnIEN: Int64): Boolean;
    351355    function  AllowContextChange(var WhyNot: string): Boolean; override;
    … …  
    364368    property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published
    365369  end;
     370
    366371
    367372var
    … …  
    638643  CurrNotifIEN := 0;
    639644  EditingIndex := -1;
    640   tvConsults.Enabled := True;
    641   lstConsults.Enabled := True ;
     645  pnlConsultList.Enabled := True; //CQ#15785
     646//  tvConsults.Enabled := True;
     647//  lstConsults.Enabled := True ;
    642648  lstNotes.Enabled := True ;
    643649  pnlRead.BringToFront ;
    … …  
    769775  try
    770776    ClearEditControls;
    771     tvConsults.Enabled := False;
    772     lstConsults.Enabled := False ;
     777    pnlConsultList.Enabled := False; //CQ#15785
     778//    tvConsults.Enabled := False;
     779//    lstConsults.Enabled := False ;
    773780    FillChar(FEditNote, SizeOf(FEditNote), 0);  //v15.7
    774781    with FEditNote do
    … …  
    899906      begin
    900907        ClearEditControls;
    901         lstConsults.Enabled := True;
    902         tvConsults.Enabled := True;
     908        pnlConsultList.Enabled := True; //CQ#15785
     909//        lstConsults.Enabled := True;
     910//        tvConsults.Enabled := True;
    903911      end;
    904912    SetResultMenus ;
    … …  
    930938  AClassName := DCL_CONSULTS;
    931939  ClearEditControls;
    932   lstConsults.Enabled := False ;
    933   tvConsults.Enabled := False;
     940  pnlConsultList.Enabled := False; //CQ#15785
     941//  lstConsults.Enabled := False ;
     942//  tvConsults.Enabled := False;
    934943  with FEditNote do
    935944  begin
    … …  
    10081017      InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
    10091018      HaveRequired := False;
    1010       lstConsults.Enabled := True;
    1011       tvConsults.Enabled := True;
     1019      pnlConsultList.Enabled := True; //CQ#15785
     1020//      lstConsults.Enabled := True;
     1021//      tvConsults.Enabled := True;
    10121022    end; {if CreatedNote.IEN}
    10131023  end; {if HaveRequired}
    … …  
    15591569end;
    15601570
     1571//wat cq 17586
     1572procedure TfrmConsults.popNoteMemoViewCsltClick(Sender: TObject);
     1573var
     1574  CsltIEN: integer ;
     1575  ConsultDetail: TStringList;
     1576  x: string;
     1577begin
     1578  inherited;
     1579  if (Screen.ActiveControl <> memResults) or (FEditNote.PkgPtr <> PKG_CONSULTS) then Exit;
     1580  CsltIEN := frmConsults.FEditNote.PkgIEN;
     1581  x := FindConsult(CsltIEN);
     1582  ConsultDetail := TStringList.Create;
     1583  try
     1584    LoadConsultDetail(ConsultDetail, CsltIEN) ;
     1585    ReportBox(ConsultDetail, 'Consult Details: #' + IntToStr(CsltIEN) + ' - ' + Piece(x, U, 4), TRUE);
     1586  finally
     1587    ConsultDetail.Free;
     1588  end;
     1589end;  //END cq 17586
     1590
    15611591procedure TfrmConsults.mnuActAddIDEntryClick(Sender: TObject);
    15621592const
    … …  
    17921822      popNoteMemoEncounter.Visible := FALSE;
    17931823      UpdateList;
    1794       lstConsults.Enabled := True ;
    1795       tvConsults.Enabled := True;
     1824      pnlConsultList.Enabled := True; //CQ#15785
     1825//      lstConsults.Enabled := True ;
     1826//      tvConsults.Enabled := True;
    17961827      with tvConsults do Selected := FindPieceNode(IntToStr(SaveConsult), 1, U, Items.GetFirstNode);
    17971828      tvConsultsClick(Self);
    … …  
    18511882          pnlResults.Visible := False;
    18521883          pnlResults.SendToBack;
    1853           lstConsults.Enabled := True;
    1854           tvConsults.Enabled := True;
     1884          pnlConsultList.Enabled := True; //CQ#15785
     1885//          lstConsults.Enabled := True;
     1886//          tvConsults.Enabled := True;
    18551887          if Notifications.Active then
    18561888            with tvConsults do
    … …  
    19712003          pnlResults.Visible := False;
    19722004          pnlResults.SendToBack;
    1973           lstConsults.Enabled := True;
    1974           tvConsults.Enabled := True;
     2005          pnlConsultList.Enabled := True; //CQ#15785
     2006//          lstConsults.Enabled := True;
     2007//          tvConsults.Enabled := True;
    19752008          if Notifications.Active then
    19762009            with tvConsults do
    … …  
    21822215  ClearEditControls ;
    21832216  lstNotes.Enabled := False ;
    2184   lstConsults.Enabled  := False ;
    2185   tvConsults.Enabled := False;
     2217  pnlConsultList.Enabled := False; //CQ#15785
     2218//  lstConsults.Enabled  := False ;
     2219//  tvConsults.Enabled := False;
    21862220  x := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 12);
    21872221  if x <> '' then
    … …  
    22232257  //UnlockConsultRequest(lstNotes.ItemIEN, lstConsults.ItemIEN);
    22242258  lstNotes.Enabled := True ;
    2225   lstConsults.Enabled := True ;
    2226   tvConsults.Enabled := True;
     2259  pnlConsultList.Enabled := True; //CQ#15785
     2260//  lstConsults.Enabled := True ;
     2261//  tvConsults.Enabled := True;
    22272262end;
    22282263
    … …  
    23962431                                        (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
    23972432                                        and
    2398                                         (ConsultRec.ORStatus=ST_COMPLETE) and
    23992433                                       ((lstNotes.ItemIndex > -1) and
    24002434                                       ((ConsultRec.TIUResultNarrative>0) or
    … …  
    26252659   if ItemIndex = EditingIndex then
    26262660     begin
    2627        lstConsults.Enabled := False ;
    2628        tvConsults.Enabled := False;
     2661       pnlConsultList.Enabled := False; //CQ#15785
     2662//       lstConsults.Enabled := False ;
     2663//       tvConsults.Enabled := False;
    26292664       pnlResults.Visible := True;
    26302665       pnlResults.BringToFront;
    … …  
    26392674       if EditingIndex = -1 then
    26402675         begin
    2641            lstConsults.Enabled := True ;
    2642            tvConsults.Enabled := True;
     2676           pnlConsultList.Enabled := True; //CQ#15785
     2677//           lstConsults.Enabled := True ;
     2678//           tvConsults.Enabled := True;
    26432679         end;
    26442680       lblTitle.Caption := MakeConsultNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]);
    … …  
    27102746    popNoteMemoPreview.Enabled  := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
    27112747    popNoteMemoInsTemplate.Enabled  := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
     2748    popNoteMemoViewCslt.Enabled := (FEditNote.PkgPtr = PKG_CONSULTS);  //wat cq 17586
    27122749  end else
    27132750  begin
    … …  
    27182755    popNoteMemoPreview.Enabled  := False;
    27192756    popNoteMemoInsTemplate.Enabled := False;
     2757    popNoteMemoViewCslt.Enabled := FALSE; //wat cq 17586
    27202758  end;
    27212759end;
    … …  
    28382876end;
    28392877
    2840 {for printing multiple notes}
    28412878procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList);
    28422879var
    … …  
    28442881  i: integer;
    28452882begin
     2883  inherited;
    28462884  with AForm.lbIDParents do
    2847   for i := 0 to Items.Count - 1 do
    2848   if Selected[i] then
    2849   begin
    2850     NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0);
    2851     if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i])
    2852     else if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK)
    2853     else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
    2854   end;
     2885  begin
     2886    for i := 0 to Items.Count - 1 do
     2887     begin
     2888       if Selected[i] then
     2889        begin
     2890         NoteIEN := ItemIEN;  //StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0);
     2891         if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) else
     2892          begin
     2893           if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
     2894           if NoteIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
     2895          end;
     2896        end; {if selected}
     2897     end; {for}
     2898  end; {with}
    28552899end;
    28562900
    … …  
    31043148  AnObject: PDocTreeObject;
    31053149  tmpNode: TORTreeNode;
     3150  I:Integer;
     3151  CommentDate: String;
     3152  Format: CHARFORMAT2;
     3153  VisibleLineCount: integer;
    31063154begin
    31073155  if EditingIndex <> -1 then
    … …  
    31163164  tvConsults.Caption := Notifications.Text;
    31173165  EditingIndex := -1;
    3118   lstConsults.Enabled := True ;
    3119   tvConsults.Enabled := True;
     3166  pnlConsultList.Enabled := True; //CQ#15785
     3167//  lstConsults.Enabled := True ;
     3168//  tvConsults.Enabled := True;
    31203169  lstNotes.Enabled := True ;
    31213170  pnlRead.BringToFront ;
    … …  
    32043253      tvCsltNotesChange(Self, tvCsltNotes.Selected);
    32053254    end
    3206   else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0) then
     3255  else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0)
     3256  and (Pos(UpperCase('Comment added'), UpperCase(Notifications.Text)) = 0) then //CB
    32073257    mnuActDisplayResultsClick(Self);
    3208    
     3258
     3259  //CB
     3260   If (Notifications.HighLightSection <> '') and (Pos(UpperCase('Comment added'), UpperCase(Notifications.Text)) > 0) then begin
     3261   CommentDate := FormatDateTime('mm/dd/yy hh:mm', StrToDateTime(StringReplace(Notifications.HighLightSection, '@', ' ', [rfReplaceAll])) );
     3262   for I := 0 to memConsult.Lines.Count - 1 do begin
     3263     If (Pos(CommentDate, memConsult.Lines.Strings[i]) > 0) and (Pos(UpperCase('ADDED COMMENT'), UpperCase(memConsult.Lines.Strings[i])) > 0) then begin
     3264      if CustomCanFocus(memconsult) then
     3265        memConsult.SetFocus;
     3266      memConsult.SelStart := memConsult.Perform(EM_LINEINDEX, i,0);
     3267      memConsult.SelLength := Length(memConsult.Lines.Strings[i]);
     3268
     3269      //Set the background color
     3270      Format.cbSize := SizeOf(Format);
     3271      Format.dwMask := CFM_BACKCOLOR;
     3272
     3273      Format.crBackColor := clRed;
     3274      memConsult.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
     3275          //Get visible Line Couunt
     3276       VisibleLineCount := LinesVisible(memConsult);
     3277
     3278      if (I + VisibleLineCount)>= memConsult.Lines.Count - 1 then
     3279        memConsult.SelStart := memConsult.Perform(EM_LINEINDEX, memConsult.Lines.Count - 1,0)
     3280      else memConsult.SelStart := memConsult.Perform(EM_LINEINDEX,I + VisibleLineCount - 1,0);
     3281
     3282      memConsult.Perform($00B7, 0, 0);  //EM_SETCARRET DEFINED WRONG in Richedit.pas
     3283      memConsult.SelLength := 0;
     3284      break;
     3285     end;
     3286   end;
     3287  end;
     3288
    32093289  case Notifications.Followup of
    32103290    NF_CONSULT_REQUEST_RESOLUTION   :  Notifications.Delete;
    … …  
    32213301  FNotifPending := False;
    32223302end;
     3303
     3304// *****************************************************************
     3305//                  Delphi's Can Focus has a bug.
     3306//     Source: http://qc.embarcadero.com/wc/qcmain.aspx?d=11229
     3307// *****************************************************************
     3308function TfrmConsults.CustomCanFocus(Control: TWinControl): Boolean;
     3309var
     3310  Form: TCustomForm;
     3311begin
     3312  Result := False;
     3313  Form := GetParentForm(Self);
     3314  if Form <> nil then
     3315  begin
     3316    Control := Self;
     3317    repeat
     3318      if not (Control.Visible and Control.Enabled) then
     3319       Exit;
     3320      Control := Control.Parent;
     3321    until Control = nil;
     3322    Result := True;
     3323  end;
     3324end;
     3325
     3326 function TfrmConsults.LinesVisible(richedit: Trichedit): integer;
     3327    Var
     3328      OldFont : HFont;
     3329      Hand : THandle;
     3330      TM : TTextMetric;
     3331      Rect  : TRect;
     3332      tempint : integer;
     3333    begin
     3334      Hand := GetDC(richedit.Handle);
     3335      try
     3336        OldFont := SelectObject(Hand, richedit.Font.Handle);
     3337        try
     3338          GetTextMetrics(Hand, TM);
     3339          richedit.Perform(EM_GETRECT, 0, longint(@Rect));
     3340          tempint := (Rect.Bottom - Rect.Top) div
     3341             (TM.tmHeight + TM.tmExternalLeading);
     3342        finally
     3343          SelectObject(Hand, OldFont);
     3344        end;
     3345      finally
     3346        ReleaseDC(richedit.Handle, Hand);
     3347      end;
     3348      Result := tempint;
     3349    end;
    32233350
    32243351procedure TfrmConsults.mnuActEditResubmitClick(Sender: TObject);
    … …  
    39484075      if not LockConsultRequest(AConsult) then Exit;
    39494076      lstNotes.Enabled := False ;
    3950       lstConsults.Enabled  := False ;
    3951       tvConsults.Enabled := False;
     4077      pnlConsultList.Enabled := False; //CQ#15785
     4078//      lstConsults.Enabled  := False ;
     4079//      tvConsults.Enabled := False;
    39524080      if ActionType = 'ATTACH' then
    39534081        begin
    … …  
    39804108    end;
    39814109  lstNotes.Enabled := True ;
    3982   lstConsults.Enabled  := True ;
    3983   tvConsults.Enabled := True;
     4110  pnlConsultList.Enabled := True; //CQ#15785
     4111//  lstConsults.Enabled  := True ;
     4112//  tvConsults.Enabled := True;
    39844113  FOrderID := GetConsultOrderIEN(AConsult);
    39854114  UnlockOrderIfAble(FOrderID);
    … …  
    40684197          cmdPCE.Visible := FALSE;
    40694198          popNoteMemoEncounter.Visible := FALSE;
    4070           lstConsults.Enabled := True ;
    4071           tvConsults.Enabled := True;
     4199          pnlConsultList.Enabled := True; //CQ#15785
     4200//          lstConsults.Enabled := True ;
     4201//          tvConsults.Enabled := True;
    40724202          lstNotes.Enabled := True;
    40734203          lblTitle.Caption := '';
    … …  
    44354565      popNoteListExpandSelected.Enabled := Selected.HasChildren;
    44364566      popNoteListCollapseSelected.Enabled := Selected.HasChildren;
    4437       lstConsults.Enabled := True ;
    4438       tvConsults.Enabled := True;
     4567      pnlConsultList.Enabled := True; //CQ#15785
     4568//      lstConsults.Enabled := True ;
     4569//      tvConsults.Enabled := True;
    44394570      lstNotes.Enabled := True;
    44404571      if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
    … …  
    44504581          cmdPCE.Visible := FALSE;
    44514582          popNoteMemoEncounter.Visible := FALSE;
    4452           lstConsults.Enabled := True ;
    4453           tvConsults.Enabled := True;
     4583          pnlConsultList.Enabled := True; //CQ#15785
     4584//          lstConsults.Enabled := True ;
     4585//          tvConsults.Enabled := True;
    44544586          KillDocTreeObjects(tvCsltNotes);
    44554587          tvCsltNotes.Items.Clear;

  • cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm

    r829 r1679  
    11inherited frmEditCslt: TfrmEditCslt
    22  Tag = 110
    3   Left = 409
    4   Top = 225
    5   Width = 599
    6   Height = 375
     3  Left = 461
     4  Top = 191
     5  Width = 576
     6  Height = 479
    77  HorzScrollBar.Range = 561
    88  VertScrollBar.Range = 340
    99  Caption = 'Edit/Resubmit a Cancelled Consult'
    10   Constraints.MinHeight = 371
    11   Constraints.MinWidth = 573
     10  Constraints.MinHeight = 467
     11  Constraints.MinWidth = 576
    1212  OldCreateOrder = True
    1313  Position = poScreenCenter
    14   ExplicitLeft = 409
    15   ExplicitTop = 225
    16   ExplicitWidth = 599
    17   ExplicitHeight = 375
     14  ExplicitWidth = 576
     15  ExplicitHeight = 479
    1816  DesignSize = (
    19     591
    20     341)
     17    568
     18    448)
    2119  PixelsPerInch = 96
    2220  TextHeight = 13
    23   object lblService: TLabel [0]
    24     Left = 4
    25     Top = 4
    26     Width = 134
    27     Height = 13
    28     Caption = 'Consult to Service/Specialty'
    29   end
    30   object lblReason: TLabel [1]
    31     Left = 4
    32     Top = 166
    33     Width = 90
    34     Height = 13
    35     Caption = 'Reason for Consult'
    36   end
    37   object lblComment: TLabel [2]
    38     Left = 4
    39     Top = 105
    40     Width = 77
    41     Height = 13
    42     Caption = 'New Comments:'
    43   end
    44   object lblComments: TLabel [3]
    45     Left = 4
    46     Top = 51
    47     Width = 89
    48     Height = 13
    49     Caption = 'Display Comments:'
    50   end
    51   object lblUrgency: TStaticText [4]
    52     Left = 196
    53     Top = 4
    54     Width = 44
    55     Height = 17
    56     Caption = 'Urgency'
    57     TabOrder = 16
    58   end
    59   object lblPlace: TStaticText [5]
    60     Left = 376
    61     Top = 41
    62     Width = 104
    63     Height = 17
    64     Caption = 'Place of Consultation'
    65     TabOrder = 17
    66   end
    67   object lblAttn: TStaticText [6]
    68     Left = 376
    69     Top = 4
    70     Width = 46
    71     Height = 17
    72     Caption = 'Attention'
    73     TabOrder = 18
    74   end
    75   object lblProvDiag: TStaticText [7]
    76     Left = 195
    77     Top = 82
    78     Width = 104
    79     Height = 17
    80     Caption = 'Provisional Diagnosis'
    81     TabOrder = 19
    82   end
    83   object lblInpOutp: TStaticText [8]
    84     Left = 197
    85     Top = 47
    86     Width = 127
    87     Height = 17
    88     Caption = 'Patient will be seen as an:'
    89     TabOrder = 20
    90   end
    91   object memReason: TRichEdit [9]
    92     Left = 4
    93     Top = 179
    94     Width = 589
    95     Height = 137
    96     Anchors = [akLeft, akTop, akRight, akBottom]
     21  object pnlCombatVet: TPanel [0]
     22    Left = 0
     23    Top = 0
     24    Width = 568
     25    Height = 25
     26    Align = alTop
     27    BevelOuter = bvLowered
    9728    Font.Charset = DEFAULT_CHARSET
    9829    Font.Color = clWindowText
    9930    Font.Height = -11
    100     Font.Name = 'Courier New'
     31    Font.Name = 'MS Sans Serif'
    10132    Font.Style = []
    10233    ParentFont = False
    103     PopupMenu = popReason
    104     ScrollBars = ssBoth
    105     TabOrder = 11
    106     WantTabs = True
    107     OnChange = ControlChange
    108     OnExit = memReasonExit
    109     OnKeyDown = memCommentKeyDown
    110     OnKeyPress = memCommentKeyPress
    111     OnKeyUp = memCommentKeyUp
    112     ExplicitHeight = 136
    113   end
    114   object pnlMessage: TPanel [10]
    115     Left = 16
    116     Top = 294
    117     Width = 418
     34    TabOrder = 0
     35    object txtCombatVet: TVA508StaticText
     36      Name = 'txtCombatVet'
     37      Left = 1
     38      Top = 1
     39      Width = 566
     40      Height = 23
     41      Align = alClient
     42      Alignment = taCenter
     43      BevelOuter = bvNone
     44      Enabled = False
     45      TabOrder = 0
     46      ShowAccelChar = True
     47    end
     48  end
     49  object pnlMessage: TPanel [1]
     50    Left = 21
     51    Top = 404
     52    Width = 388
    11853    Height = 44
    11954    Anchors = [akLeft, akRight, akBottom]
    … …  
    12156    BorderStyle = bsSingle
    12257    Caption = 'pnlMessage'
    123     TabOrder = 15
     58    TabOrder = 4
    12459    Visible = False
    12560    object imgMessage: TImage
    … …  
    14681    end
    14782  end
    148   object cboService: TORComboBox [11]
    149     Left = 4
    150     Top = 19
    151     Width = 180
    152     Height = 21
    153     Style = orcsDropDown
    154     AutoSelect = True
    155     Caption = 'Consult to Service/Specialty'
    156     Color = clWindow
    157     DropDownCount = 8
    158     Enabled = False
    159     Font.Charset = DEFAULT_CHARSET
    160     Font.Color = clGrayText
    161     Font.Height = -11
    162     Font.Name = 'MS Sans Serif'
    163     Font.Style = []
    164     ItemHeight = 13
    165     ItemTipColor = clWindow
    166     ItemTipEnable = True
    167     ListItemsOnly = True
    168     LongList = False
    169     LookupPiece = 0
    170     MaxLength = 0
    171     ParentFont = False
    172     Pieces = '2'
    173     Sorted = True
    174     SynonymChars = '<>'
    175     TabOrder = 0
    176     CharsNeedMatch = 1
    177   end
    178   object cboUrgency: TORComboBox [12]
    179     Left = 196
    180     Top = 19
    181     Width = 170
    182     Height = 21
    183     Style = orcsDropDown
    184     AutoSelect = True
    185     Caption = 'Urgency'
    186     Color = clWindow
    187     DropDownCount = 8
    188     ItemHeight = 13
    189     ItemTipColor = clWindow
    190     ItemTipEnable = True
    191     ListItemsOnly = True
    192     LongList = False
    193     LookupPiece = 0
    194     MaxLength = 0
    195     Pieces = '2'
    196     Sorted = False
    197     SynonymChars = '<>'
    198     TabOrder = 1
    199     OnChange = ControlChange
    200     CharsNeedMatch = 1
    201   end
    202   object radInpatient: TRadioButton [13]
    203     Left = 197
    204     Top = 61
    205     Width = 61
    206     Height = 17
    207     Caption = '&Inpatient'
    208     TabOrder = 5
    209     OnClick = radInpatientClick
    210   end
    211   object radOutpatient: TRadioButton [14]
    212     Left = 269
    213     Top = 61
    214     Width = 73
    215     Height = 17
    216     Caption = '&Outpatient'
    217     TabOrder = 6
    218     OnClick = radOutpatientClick
    219   end
    220   object cboPlace: TORComboBox [15]
    221     Left = 376
    222     Top = 54
    223     Width = 216
    224     Height = 21
    225     Anchors = [akLeft, akTop, akRight]
    226     Style = orcsDropDown
    227     AutoSelect = True
    228     Caption = 'Place of Consultation'
    229     Color = clWindow
    230     DropDownCount = 8
    231     ItemHeight = 13
    232     ItemTipColor = clWindow
    233     ItemTipEnable = True
    234     ListItemsOnly = True
    235     LongList = False
    236     LookupPiece = 0
    237     MaxLength = 0
    238     Pieces = '2'
    239     Sorted = False
    240     SynonymChars = '<>'
    241     TabOrder = 7
    242     OnChange = ControlChange
    243     CharsNeedMatch = 1
    244   end
    245   object txtProvDiag: TCaptionEdit [16]
    246     Left = 195
    247     Top = 95
    248     Width = 346
    249     Height = 21
    250     Anchors = [akLeft, akTop, akRight]
    251     MaxLength = 180
    252     ParentShowHint = False
    253     PopupMenu = mnuPopProvDx
    254     ShowHint = True
    255     TabOrder = 8
    256     OnChange = ControlChange
    257     Caption = 'Provisional Diagnosis'
    258   end
    259   object txtAttn: TORComboBox [17]
    260     Left = 376
    261     Top = 19
    262     Width = 218
    263     Height = 21
    264     Anchors = [akLeft, akTop, akRight]
    265     Style = orcsDropDown
    266     AutoSelect = True
    267     Caption = 'Attention'
    268     Color = clWindow
    269     DropDownCount = 8
    270     ItemHeight = 13
    271     ItemTipColor = clWindow
    272     ItemTipEnable = True
    273     ListItemsOnly = True
    274     LongList = True
    275     LookupPiece = 2
    276     MaxLength = 0
    277     Pieces = '2,3'
    278     Sorted = False
    279     SynonymChars = '<>'
    280     TabOrder = 2
    281     OnChange = ControlChange
    282     OnNeedData = txtAttnNeedData
    283     CharsNeedMatch = 1
    284   end
    285   object cboCategory: TORComboBox [18]
    286     Left = 561
    287     Top = 103
    288     Width = 10
    289     Height = 21
    290     Style = orcsDropDown
    291     AutoSelect = True
    292     Color = clWindow
    293     DropDownCount = 8
    294     ItemHeight = 13
    295     ItemTipColor = clWindow
    296     ItemTipEnable = True
    297     ListItemsOnly = False
    298     LongList = False
    299     LookupPiece = 0
    300     MaxLength = 0
    301     Sorted = False
    302     SynonymChars = '<>'
    303     TabOrder = 14
    304     Visible = False
    305     CharsNeedMatch = 1
    306   end
    307   object cmdAccept: TButton [19]
    308     Left = 437
    309     Top = 319
     83  object cmdAccept: TButton [2]
     84    Left = 414
     85    Top = 425
    31086    Width = 72
    31187    Height = 21
    31288    Anchors = [akRight, akBottom]
    31389    Caption = 'Resubmit'
    314     TabOrder = 12
     90    TabOrder = 2
    31591    OnClick = cmdAcceptClick
    31692  end
    317   object cmdQuit: TButton [20]
    318     Left = 514
    319     Top = 319
     93  object cmdQuit: TButton [3]
     94    Left = 491
     95    Top = 425
    32096    Width = 72
    32197    Height = 21
    … …  
    32399    Cancel = True
    324100    Caption = 'Cancel'
    325     TabOrder = 13
     101    TabOrder = 3
    326102    OnClick = cmdQuitClick
    327103  end
    328   object memComment: TRichEdit [21]
    329     Left = 4
    330     Top = 121
    331     Width = 587
    332     Height = 41
    333     Anchors = [akLeft, akTop, akRight]
    334     PopupMenu = popReason
    335     TabOrder = 10
    336     WantTabs = True
    337     OnChange = ControlChange
    338     OnKeyDown = memCommentKeyDown
    339     OnKeyPress = memCommentKeyPress
    340     OnKeyUp = memCommentKeyUp
    341   end
    342   object btnCmtCancel: TButton [22]
    343     Left = 110
    344     Top = 49
    345     Width = 75
    346     Height = 21
    347     Caption = 'Cancellation'
    348     TabOrder = 3
    349     OnClick = btnCmtCancelClick
    350   end
    351   object btnCmtOther: TButton [23]
    352     Left = 110
    353     Top = 75
    354     Width = 75
    355     Height = 21
    356     Caption = 'Other'
    357     TabOrder = 4
    358     OnClick = btnCmtOtherClick
    359   end
    360   object cmdLexSearch: TButton [24]
    361     Left = 545
    362     Top = 95
    363     Width = 46
    364     Height = 21
    365     Anchors = [akTop, akRight]
    366     Caption = 'Lexicon'
    367     TabOrder = 9
    368     OnClick = cmdLexSearchClick
     104  object pnlMain: TPanel [4]
     105    Left = 0
     106    Top = 0
     107    Width = 569
     108    Height = 402
     109    Anchors = [akLeft, akTop, akRight, akBottom]
     110    BevelOuter = bvNone
     111    TabOrder = 1
     112    DesignSize = (
     113      569
     114      402)
     115    object lblService: TLabel
     116      Left = 4
     117      Top = 4
     118      Width = 134
     119      Height = 13
     120      Caption = 'Consult to Service/Specialty'
     121    end
     122    object lblReason: TLabel
     123      Left = 4
     124      Top = 227
     125      Width = 95
     126      Height = 13
     127      Caption = 'Reason for Request'
     128    end
     129    object lblComment: TLabel
     130      Left = 4
     131      Top = 169
     132      Width = 77
     133      Height = 13
     134      Caption = 'New Comments:'
     135    end
     136    object lblComments: TLabel
     137      Left = 8
     138      Top = 108
     139      Width = 89
     140      Height = 13
     141      Caption = 'Display Comments:'
     142    end
     143    object lblUrgency: TStaticText
     144      Left = 196
     145      Top = 4
     146      Width = 44
     147      Height = 17
     148      Caption = 'Urgency'
     149      TabOrder = 14
     150    end
     151    object lblPlace: TStaticText
     152      Left = 376
     153      Top = 93
     154      Width = 104
     155      Height = 17
     156      Caption = 'Place of Consultation'
     157      TabOrder = 15
     158    end
     159    object lblAttn: TStaticText
     160      Left = 376
     161      Top = 4
     162      Width = 46
     163      Height = 17
     164      Caption = 'Attention'
     165      TabOrder = 16
     166    end
     167    object lblProvDiag: TStaticText
     168      Left = 195
     169      Top = 134
     170      Width = 104
     171      Height = 17
     172      Caption = 'Provisional Diagnosis'
     173      TabOrder = 17
     174    end
     175    object lblInpOutp: TStaticText
     176      Left = 197
     177      Top = 99
     178      Width = 127
     179      Height = 17
     180      Caption = 'Patient will be seen as an:'
     181      TabOrder = 18
     182    end
     183    object memReason: TRichEdit
     184      Left = 4
     185      Top = 240
     186      Width = 559
     187      Height = 161
     188      Anchors = [akLeft, akTop, akRight, akBottom]
     189      Font.Charset = DEFAULT_CHARSET
     190      Font.Color = clWindowText
     191      Font.Height = -11
     192      Font.Name = 'Courier New'
     193      Font.Style = []
     194      ParentFont = False
     195      PopupMenu = popReason
     196      ScrollBars = ssBoth
     197      TabOrder = 12
     198      WantTabs = True
     199      OnChange = ControlChange
     200      OnExit = memReasonExit
     201      OnKeyDown = memCommentKeyDown
     202      OnKeyPress = memCommentKeyPress
     203      OnKeyUp = memCommentKeyUp
     204    end
     205    object cboService: TORComboBox
     206      Left = 4
     207      Top = 19
     208      Width = 180
     209      Height = 83
     210      Style = orcsSimple
     211      AutoSelect = True
     212      Caption = 'Consult to Service/Specialty'
     213      Color = clWindow
     214      DropDownCount = 8
     215      Enabled = False
     216      Font.Charset = DEFAULT_CHARSET
     217      Font.Color = clGrayText
     218      Font.Height = -11
     219      Font.Name = 'MS Sans Serif'
     220      Font.Style = []
     221      ItemHeight = 13
     222      ItemTipColor = clWindow
     223      ItemTipEnable = True
     224      ListItemsOnly = True
     225      LongList = False
     226      LookupPiece = 0
     227      MaxLength = 0
     228      ParentFont = False
     229      Pieces = '2'
     230      Sorted = True
     231      SynonymChars = '<>'
     232      TabOrder = 0
     233      CharsNeedMatch = 1
     234    end
     235    object cboUrgency: TORComboBox
     236      Left = 196
     237      Top = 19
     238      Width = 170
     239      Height = 21
     240      Style = orcsDropDown
     241      AutoSelect = True
     242      Caption = 'Urgency'
     243      Color = clWindow
     244      DropDownCount = 8
     245      ItemHeight = 13
     246      ItemTipColor = clWindow
     247      ItemTipEnable = True
     248      ListItemsOnly = True
     249      LongList = False
     250      LookupPiece = 0
     251      MaxLength = 0
     252      Pieces = '2'
     253      Sorted = False
     254      SynonymChars = '<>'
     255      TabOrder = 1
     256      OnChange = ControlChange
     257      CharsNeedMatch = 1
     258    end
     259    object radInpatient: TRadioButton
     260      Left = 197
     261      Top = 113
     262      Width = 61
     263      Height = 17
     264      Caption = '&Inpatient'
     265      TabOrder = 6
     266      OnClick = radInpatientClick
     267    end
     268    object radOutpatient: TRadioButton
     269      Left = 269
     270      Top = 113
     271      Width = 73
     272      Height = 17
     273      Caption = '&Outpatient'
     274      TabOrder = 7
     275      OnClick = radOutpatientClick
     276    end
     277    object cboPlace: TORComboBox
     278      Left = 376
     279      Top = 106
     280      Width = 188
     281      Height = 21
     282      Anchors = [akLeft, akTop, akRight]
     283      Style = orcsDropDown
     284      AutoSelect = True
     285      Caption = 'Place of Consultation'
     286      Color = clWindow
     287      DropDownCount = 8
     288      ItemHeight = 13
     289      ItemTipColor = clWindow
     290      ItemTipEnable = True
     291      ListItemsOnly = True
     292      LongList = False
     293      LookupPiece = 0
     294      MaxLength = 0
     295      Pieces = '2'
     296      Sorted = False
     297      SynonymChars = '<>'
     298      TabOrder = 8
     299      OnChange = ControlChange
     300      CharsNeedMatch = 1
     301    end
     302    object txtProvDiag: TCaptionEdit
     303      Left = 195
     304      Top = 147
     305      Width = 316
     306      Height = 21
     307      Anchors = [akLeft, akTop, akRight]
     308      MaxLength = 180
     309      ParentShowHint = False
     310      PopupMenu = mnuPopProvDx
     311      ShowHint = True
     312      TabOrder = 10
     313      OnChange = ControlChange
     314      Caption = 'Provisional Diagnosis'
     315    end
     316    object txtAttn: TORComboBox
     317      Left = 376
     318      Top = 19
     319      Width = 188
     320      Height = 21
     321      Anchors = [akLeft, akTop, akRight]
     322      Style = orcsDropDown
     323      AutoSelect = True
     324      Caption = 'Attention'
     325      Color = clWindow
     326      DropDownCount = 8
     327      ItemHeight = 13
     328      ItemTipColor = clWindow
     329      ItemTipEnable = True
     330      ListItemsOnly = True
     331      LongList = True
     332      LookupPiece = 2
     333      MaxLength = 0
     334      Pieces = '2,3'
     335      Sorted = False
     336      SynonymChars = '<>'
     337      TabOrder = 2
     338      OnChange = ControlChange
     339      OnNeedData = txtAttnNeedData
     340      CharsNeedMatch = 1
     341    end
     342    object cboCategory: TORComboBox
     343      Left = 559
     344      Top = 103
     345      Width = 10
     346      Height = 21
     347      Style = orcsDropDown
     348      AutoSelect = True
     349      Color = clWindow
     350      DropDownCount = 8
     351      ItemHeight = 13
     352      ItemTipColor = clWindow
     353      ItemTipEnable = True
     354      ListItemsOnly = False
     355      LongList = False
     356      LookupPiece = 0
     357      MaxLength = 0
     358      Sorted = False
     359      SynonymChars = '<>'
     360      TabOrder = 13
     361      Visible = False
     362      CharsNeedMatch = 1
     363    end
     364    object memComment: TRichEdit
     365      Left = 4
     366      Top = 185
     367      Width = 557
     368      Height = 41
     369      Anchors = [akLeft, akTop, akRight]
     370      PopupMenu = popReason
     371      TabOrder = 11
     372      WantTabs = True
     373      OnChange = ControlChange
     374      OnExit = memCommentExit
     375      OnKeyDown = memCommentKeyDown
     376      OnKeyPress = memCommentKeyPress
     377      OnKeyUp = memCommentKeyUp
     378    end
     379    object btnCmtCancel: TButton
     380      Left = 8
     381      Top = 127
     382      Width = 75
     383      Height = 21
     384      Caption = 'Cancellation'
     385      TabOrder = 4
     386      OnClick = btnCmtCancelClick
     387    end
     388    object btnCmtOther: TButton
     389      Left = 110
     390      Top = 127
     391      Width = 75
     392      Height = 21
     393      Caption = 'Other'
     394      TabOrder = 5
     395      OnClick = btnCmtOtherClick
     396    end
     397    object cmdLexSearch: TButton
     398      Left = 515
     399      Top = 147
     400      Width = 46
     401      Height = 21
     402      Anchors = [akTop, akRight]
     403      Caption = 'Lexicon'
     404      TabOrder = 9
     405      OnClick = cmdLexSearchClick
     406    end
     407    object lblEarliest: TStaticText
     408      Left = 197
     409      Top = 46
     410      Width = 121
     411      Height = 17
     412      Caption = 'Earliest appropriate date:'
     413      TabOrder = 19
     414    end
     415    object calEarliest: TORDateBox
     416      Left = 197
     417      Top = 62
     418      Width = 164
     419      Height = 21
     420      TabOrder = 3
     421      OnExit = calEarliestExit
     422      DateOnly = True
     423      RequireTime = False
     424    end
     425    object lblLatest: TStaticText
     426      Left = 376
     427      Top = 46
     428      Width = 116
     429      Height = 17
     430      Caption = 'Latest appropriate date:'
     431      TabOrder = 21
     432      Visible = False
     433    end
     434    object calLatest: TORDateBox
     435      Left = 378
     436      Top = 62
     437      Width = 188
     438      Height = 21
     439      Anchors = [akLeft, akTop, akRight]
     440      TabOrder = 22
     441      Visible = False
     442      OnExit = calLatestExit
     443      DateOnly = True
     444      RequireTime = False
     445    end
    369446  end
    370447  inherited amgrMain: TVA508AccessibilityManager
    371448    Data = (
    372449      (
     450        'Component = pnlMessage'
     451        'Status = stsDefault')
     452      (
     453        'Component = memMessage'
     454        'Status = stsDefault')
     455      (
     456        'Component = cmdAccept'
     457        'Status = stsDefault')
     458      (
     459        'Component = cmdQuit'
     460        'Status = stsDefault')
     461      (
     462        'Component = frmEditCslt'
     463        'Status = stsDefault')
     464      (
     465        'Component = pnlMain'
     466        'Status = stsDefault')
     467      (
    373468        'Component = lblUrgency'
    374469        'Status = stsDefault')
    … …  
    389484        'Status = stsDefault')
    390485      (
    391         'Component = pnlMessage'
    392         'Status = stsDefault')
    393       (
    394         'Component = memMessage'
    395         'Status = stsDefault')
    396       (
    397486        'Component = cboService'
    398487        'Status = stsDefault')
    … …  
    419508        'Status = stsDefault')
    420509      (
    421         'Component = cmdAccept'
    422         'Status = stsDefault')
    423       (
    424         'Component = cmdQuit'
    425         'Status = stsDefault')
    426       (
    427510        'Component = memComment'
    428511        'Status = stsDefault')
    … …  
    437520        'Status = stsDefault')
    438521      (
    439         'Component = frmEditCslt'
     522        'Component = lblEarliest'
     523        'Status = stsDefault')
     524      (
     525        'Component = calEarliest'
     526        'Status = stsDefault')
     527      (
     528        'Component = lblLatest'
     529        'Status = stsDefault')
     530      (
     531        'Component = calLatest'
     532        'Status = stsDefault')
     533      (
     534        'Component = pnlCombatVet'
     535        'Status = stsDefault')
     536      (
     537        'Component = txtCombatVet'
    440538        'Status = stsDefault'))
    441539  end
    442540  object mnuPopProvDx: TPopupMenu
    443541    Left = 353
    444     Top = 77
     542    Top = 129
    445543    object mnuPopProvDxDelete: TMenuItem
    446544      Caption = 'Delete diagnosis'
    … …  
    450548  object popReason: TPopupMenu
    451549    OnPopup = popReasonPopup
    452     Left = 411
    453     Top = 169
     550    Left = 523
     551    Top = 369
    454552    object popReasonCut: TMenuItem
    455553      Caption = 'Cu&t'

  • cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas

    r829 r1679  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
    8   Menus, fBase508Form, VA508AccessibilityManager;
     8  Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form;
    99
    1010type
    11   TfrmEditCslt = class(TfrmBase508Form)
     11  TfrmEditCslt = class(TfrmAutoSz)
     12    pnlMessage: TPanel;
     13    imgMessage: TImage;
     14    memMessage: TRichEdit;
     15    cmdAccept: TButton;
     16    cmdQuit: TButton;
     17    pnlMain: TPanel;
     18    lblService: TLabel;
     19    lblReason: TLabel;
     20    lblComment: TLabel;
     21    lblComments: TLabel;
     22    lblUrgency: TStaticText;
     23    lblPlace: TStaticText;
     24    lblAttn: TStaticText;
     25    lblProvDiag: TStaticText;
     26    lblInpOutp: TStaticText;
     27    memReason: TRichEdit;
    1228    cboService: TORComboBox;
    1329    cboUrgency: TORComboBox;
    … …  
    1733    txtProvDiag: TCaptionEdit;
    1834    txtAttn: TORComboBox;
    19     lblReason: TLabel;
    20     lblService: TLabel;
    21     lblUrgency: TStaticText;
    22     lblPlace: TStaticText;
    23     lblAttn: TStaticText;
    24     lblProvDiag: TStaticText;
    2535    cboCategory: TORComboBox;
    26     pnlMessage: TPanel;
    27     imgMessage: TImage;
    28     memMessage: TRichEdit;
    29     cmdAccept: TButton;
    30     cmdQuit: TButton;
    3136    memComment: TRichEdit;
    32     lblComment: TLabel;
    33     lblComments: TLabel;
    3437    btnCmtCancel: TButton;
    3538    btnCmtOther: TButton;
     39    cmdLexSearch: TButton;
     40    lblEarliest: TStaticText;
     41    calEarliest: TORDateBox;
     42    lblLatest: TStaticText;
     43    calLatest: TORDateBox;
    3644    mnuPopProvDx: TPopupMenu;
    3745    mnuPopProvDxDelete: TMenuItem;
    38     cmdLexSearch: TButton;
    39     lblInpOutp: TStaticText;
    40     memReason: TRichEdit;
    4146    popReason: TPopupMenu;
    4247    popReasonCut: TMenuItem;
    … …  
    4550    popReasonPaste2: TMenuItem;
    4651    popReasonReformat: TMenuItem;
     52    pnlCombatVet: TPanel;
     53    txtCombatVet: TVA508StaticText;
    4754    procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
    4855      Direction, InsertAt: Integer);
    … …  
    6976      Shift: TShiftState);
    7077    procedure memCommentKeyPress(Sender: TObject; var Key: Char);
     78    procedure calEarliestExit(Sender: TObject);
     79    procedure calLatestExit(Sender: TObject);
     80    procedure memCommentExit(Sender: TObject);
    7181  private
    7282    FLastServiceID: string;
    … …  
    7585    FEditCtrl: TCustomEdit;
    7686    FNavigatingTab: boolean;
     87    FEarliestDate: TFMDateTime;
     88    FProstheticsSvc: boolean;
     89    //FLatestDate: TFMDateTime;
    7790    procedure SetProvDiagPromptingMode;
     91    procedure SetUpCombatVet;
     92    procedure SetUpEarliestDate;
    7893  protected
    7994    procedure InitDialog;
    … …  
    118133                       'Another code must be selected';
    119134  TC_INACTIVE_CODE   = 'Inactive ICD Code';
     135  TX_PAST_DATE       = 'Earliest appropriate date must be today or later.';
     136  TX_BAD_DATES       = 'Latest appropriate date must be equal to or later than earliest date.';
    120137
    121138function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean;
    … …  
    196213  with cboUrgency do for i := 0 to Items.Count-1 do
    197214    if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i;
     215  SetUpEarliestDate;         //wat v28
     216  if Not FProstheticsSvc then         //wat v28
     217    begin
     218      calEarliest.FMDateTime := OldRec.EarliestDate;
     219      FEarliestDate := OldRec.EarliestDate;
     220      //calLatest.FMDateTime := OldRec.LatestDate;
     221      //FLatestDate := OldRec.LatestDate;
     222    end;
    198223  txtProvDiag.Text := OldRec.ProvDiagnosis;
    199224  ProvDx.Code := OldRec.ProvDxCode;
    … …  
    213238    txtAttn.ItemIndex := -1;
    214239  SetProvDiagPromptingMode;
     240  if (patient.CombatVet.IsEligible = True) then
     241   begin
     242    SetUpCombatVet;
     243   end
     244   else
     245    begin
     246      txtCombatVet.Enabled := False;
     247      pnlCombatVet.SendToBack;
     248    end;
    215249  FChanging := False;
    216250  StatusText('');
    … …  
    247281  if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
    248282    SetError(TX_INACTIVE_CODE);
     283  if Not FProstheticsSvc then     //wat v28
     284    begin
     285       if calEarliest.FMDateTime < FMToday     then SetError(TX_PAST_DATE);
     286       //if calLatest.FMDateTime < FMToday       then SetError(TX_PAST_DATE);
     287       //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
     288    end;
     289
    249290end;
    250291
    … …  
    317358           UrgencyName := '';
    318359         end;
     360
     361     if FEarliestDate > 0 then
     362     begin
     363       if FEarliestDate <> OldRec.EarliestDate then
     364         EarliestDate := FEarliestDate
     365       else
     366         EarliestDate := 0;
     367     end;
     368
     369(*     if FLatestDate > 0 then
     370     begin
     371       if FLatestDate <> OldRec.LatestDate then
     372         LatestDate := FLatestDate
     373       else
     374         LatestDate := 0;
     375     end;*)
    319376
    320377     with cboPlace do if Length(ItemID) > 0 then
    … …  
    408465end;
    409466
     467procedure TfrmEditCslt.calEarliestExit(Sender: TObject);
     468begin
     469  inherited;
     470  FEarliestDate := calEarliest.FMDateTime;
     471  ControlChange(Self);
     472end;
     473
     474procedure TfrmEditCslt.calLatestExit(Sender: TObject);
     475begin
     476  inherited;
     477  //FLatestDate := calLatest.FMDateTime;
     478  //ControlChange(Self);
     479end;
     480
    410481procedure TfrmEditCslt.cmdAcceptClick(Sender: TObject);
    411482{Begin BillingAware}
    … …  
    478549  if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) and (ProvDx.PromptMode = 'L') then
    479550    cmdLexSearchClick(Self);
     551end;
     552
     553procedure TfrmEditCslt.SetUpCombatVet;
     554begin
     555  pnlCombatVet.BringToFront;
     556  txtCombatVet.Enabled := True;
     557  txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
     558  pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
     559  pnlMain.Anchors := [akLeft, akTop, akRight];
     560  self.Height := self.Height + pnlCombatVet.Height;
     561  pnlMain.Anchors := [akLeft, akTop, akRight, akBottom];
     562  ActiveControl := txtCombatVet;
    480563end;
    481564
    … …  
    655738end;
    656739
     740procedure TfrmEditCslt.memCommentExit(Sender: TObject);
     741//added OnExit code for CQ17822 WAT
     742var
     743  AStringList: TStringList;
     744begin
     745  inherited;
     746  AStringList := TStringList.Create;
     747  try
     748    //QuickCopy(memComment, AStringList);
     749    AStringList.Text := memComment.Text;
     750    LimitStringLength(AStringList, 74);
     751    //QuickCopy(AstringList, memComment);
     752    memComment.Text := AStringList.Text;
     753    ControlChange(Self);   
     754  finally
     755    AStringList.Free;
     756  end;
     757end;
     758
    657759procedure TfrmEditCslt.memCommentKeyDown(Sender: TObject; var Key: Word;
    658760  Shift: TShiftState);
    … …  
    671773end;
    672774
     775procedure TfrmEditCslt.SetUpEarliestDate;  //wat v28
     776begin
     777  if IsProstheticsService(cboService.ItemIEN) = '1' then
     778    begin
     779      lblEarliest.Enabled := False;
     780      calEarliest.Enabled := False;
     781      calEarliest.Text := '';
     782      FProstheticsSvc := true;
     783    end
     784  else
     785    begin
     786      lblEarliest.Enabled := True;
     787      calEarliest.Enabled := True;
     788      calEarliest.Text := 'TODAY';
     789      FProstheticsSvc := false;
     790    end;
     791end;
     792
    673793end.

  • cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm

    r829 r1679  
    11inherited frmEditProc: TfrmEditProc
    22  Tag = 112
    3   Left = 296
    4   Top = 245
    5   Width = 571
    6   Height = 359
     3  Left = 408
     4  Top = 210
     5  Width = 580
     6  Height = 458
    77  HorzScrollBar.Range = 561
    88  VertScrollBar.Range = 308
    99  Caption = 'Edit and resubmit a cancelled procedure'
    10   Constraints.MinHeight = 359
    11   Constraints.MinWidth = 571
    12   OldCreateOrder = True
     10  Constraints.MinHeight = 458
     11  Constraints.MinWidth = 580
    1312  Position = poScreenCenter
    14   ExplicitLeft = 296
    15   ExplicitTop = 245
    16   ExplicitWidth = 571
    17   ExplicitHeight = 359
     13  ExplicitWidth = 580
     14  ExplicitHeight = 458
    1815  DesignSize = (
    19     563
    20     325)
     16    572
     17    424)
    2118  PixelsPerInch = 96
    2219  TextHeight = 13
    23   object lblProc: TLabel [0]
    24     Left = 3
    25     Top = 7
    26     Width = 49
    27     Height = 13
    28     Caption = 'Procedure'
    29   end
    30   object lblReason: TLabel [1]
    31     Left = 3
    32     Top = 167
    33     Width = 90
    34     Height = 13
    35     Caption = 'Reason for Consult'
    36   end
    37   object lblService: TOROffsetLabel [2]
    38     Left = 3
    39     Top = 49
    40     Width = 158
    41     Height = 15
    42     Caption = 'Service to perform this procedure'
    43     HorzOffset = 2
    44     Transparent = False
    45     VertOffset = 2
    46     WordWrap = False
    47   end
    48   object lblComment: TLabel [3]
    49     Left = 106
    50     Top = 109
    51     Width = 74
    52     Height = 13
    53     Caption = 'New Comments'
    54   end
    55   object lblComments: TLabel [4]
    56     Left = 3
    57     Top = 99
    58     Width = 89
    59     Height = 13
    60     Caption = 'Display Comments:'
    61   end
    62   object lblUrgency: TStaticText [5]
    63     Left = 190
    64     Top = 7
    65     Width = 44
    66     Height = 17
    67     Caption = 'Urgency'
    68     TabOrder = 18
    69   end
    70   object lblPlace: TStaticText [6]
    71     Left = 362
    72     Top = 50
    73     Width = 104
    74     Height = 17
    75     Caption = 'Place of Consultation'
    76     TabOrder = 19
    77   end
    78   object lblAttn: TStaticText [7]
    79     Left = 362
    80     Top = 7
    81     Width = 46
    82     Height = 17
    83     Caption = 'Attention'
    84     TabOrder = 20
    85   end
    86   object lblProvDiag: TStaticText [8]
    87     Left = 190
    88     Top = 81
    89     Width = 104
    90     Height = 17
    91     Caption = 'Provisional Diagnosis'
    92     TabOrder = 21
    93   end
    94   object lblInpOutp: TStaticText [9]
    95     Left = 192
    96     Top = 48
    97     Width = 127
    98     Height = 17
    99     Caption = 'Patient will be seen as an:'
    100     TabOrder = 17
    101   end
    102   object memReason: TRichEdit [10]
    103     Left = 2
    104     Top = 181
    105     Width = 557
    106     Height = 119
    107     Anchors = [akLeft, akTop, akRight, akBottom]
     20  object pnlCombatVet: TPanel [0]
     21    Left = 0
     22    Top = 0
     23    Width = 572
     24    Height = 25
     25    Align = alTop
     26    BevelOuter = bvLowered
    10827    Font.Charset = DEFAULT_CHARSET
    10928    Font.Color = clWindowText
    11029    Font.Height = -11
    111     Font.Name = 'Courier New'
     30    Font.Name = 'MS Sans Serif'
    11231    Font.Style = []
    11332    ParentFont = False
    114     PopupMenu = popReason
    115     ScrollBars = ssBoth
    116     TabOrder = 12
    117     WantTabs = True
    118     OnChange = ControlChange
    119     OnExit = memReasonExit
    120     OnKeyDown = memReasonKeyDown
    121     OnKeyPress = memReasonKeyPress
    122     OnKeyUp = memCommentKeyUp
    123   end
    124   object cmdAccept: TButton [11]
    125     Left = 401
    126     Top = 303
     33    TabOrder = 0
     34    object txtCombatVet: TVA508StaticText
     35      Name = 'txtCombatVet'
     36      Left = 1
     37      Top = 1
     38      Width = 570
     39      Height = 23
     40      Align = alClient
     41      Alignment = taCenter
     42      BevelOuter = bvNone
     43      Enabled = False
     44      TabOrder = 0
     45      ShowAccelChar = True
     46    end
     47  end
     48  object cmdAccept: TButton [1]
     49    Left = 410
     50    Top = 400
    12751    Width = 72
    12852    Height = 21
    12953    Anchors = [akRight, akBottom]
    13054    Caption = 'Resubmit'
    131     TabOrder = 13
     55    TabOrder = 2
    13256    OnClick = cmdAcceptClick
    13357  end
    134   object cmdQuit: TButton [12]
    135     Left = 486
    136     Top = 303
     58  object cmdQuit: TButton [2]
     59    Left = 495
     60    Top = 400
    13761    Width = 72
    13862    Height = 21
    … …  
    14064    Cancel = True
    14165    Caption = 'Cancel'
    142     TabOrder = 14
     66    TabOrder = 3
    14367    OnClick = cmdQuitClick
    14468  end
    145   object cboUrgency: TORComboBox [13]
    146     Left = 190
    147     Top = 22
    148     Width = 165
    149     Height = 21
    150     Style = orcsDropDown
    151     AutoSelect = True
    152     Caption = 'Urgency'
    153     Color = clWindow
    154     DropDownCount = 8
    155     ItemHeight = 13
    156     ItemTipColor = clWindow
    157     ItemTipEnable = True
    158     ListItemsOnly = True
    159     LongList = False
    160     LookupPiece = 0
    161     MaxLength = 0
    162     Pieces = '2'
    163     Sorted = False
    164     SynonymChars = '<>'
    165     TabOrder = 2
    166     OnChange = ControlChange
    167     CharsNeedMatch = 1
    168   end
    169   object radInpatient: TRadioButton [14]
    170     Left = 190
    171     Top = 61
    172     Width = 61
    173     Height = 17
    174     Caption = '&Inpatient'
    175     TabOrder = 4
    176     OnClick = radInpatientClick
    177   end
    178   object radOutpatient: TRadioButton [15]
    179     Left = 264
    180     Top = 61
    181     Width = 73
    182     Height = 17
    183     Caption = '&Outpatient'
    184     TabOrder = 5
    185     OnClick = radOutpatientClick
    186   end
    187   object cboPlace: TORComboBox [16]
    188     Left = 362
    189     Top = 63
    190     Width = 197
    191     Height = 21
    192     Anchors = [akLeft, akTop, akRight]
    193     Style = orcsDropDown
    194     AutoSelect = True
    195     Caption = 'Place of Consultation'
    196     Color = clWindow
    197     DropDownCount = 8
    198     ItemHeight = 13
    199     ItemTipColor = clWindow
    200     ItemTipEnable = True
    201     ListItemsOnly = True
    202     LongList = False
    203     LookupPiece = 0
    204     MaxLength = 0
    205     Pieces = '2'
    206     Sorted = False
    207     SynonymChars = '<>'
    208     TabOrder = 6
    209     OnChange = ControlChange
    210     CharsNeedMatch = 1
    211     ExplicitWidth = 195
    212   end
    213   object txtProvDiag: TCaptionEdit [17]
    214     Left = 190
    215     Top = 94
    216     Width = 315
    217     Height = 21
    218     Anchors = [akLeft, akTop, akRight]
    219     MaxLength = 180
    220     ParentShowHint = False
    221     PopupMenu = mnuPopProvDx
    222     ShowHint = True
    223     TabOrder = 7
    224     OnChange = ControlChange
    225     Caption = 'Provisional Diagnosis'
    226   end
    227   object txtAttn: TORComboBox [18]
    228     Left = 362
    229     Top = 22
    230     Width = 197
    231     Height = 21
    232     Anchors = [akLeft, akTop, akRight]
    233     Style = orcsDropDown
    234     AutoSelect = True
    235     Caption = 'Attention'
    236     Color = clWindow
    237     DropDownCount = 8
    238     ItemHeight = 13
    239     ItemTipColor = clWindow
    240     ItemTipEnable = True
    241     ListItemsOnly = True
    242     LongList = True
    243     LookupPiece = 2
    244     MaxLength = 0
    245     Pieces = '2,3'
    246     Sorted = False
    247     SynonymChars = '<>'
    248     TabOrder = 3
    249     OnChange = ControlChange
    250     OnNeedData = txtAttnNeedData
    251     CharsNeedMatch = 1
    252     ExplicitWidth = 195
    253   end
    254   object cboProc: TORComboBox [19]
    255     Left = 3
    256     Top = 22
    257     Width = 173
    258     Height = 21
    259     Style = orcsDropDown
    260     AutoSelect = True
    261     Caption = 'Procedure'
    262     Color = clWindow
    263     DropDownCount = 8
    264     Enabled = False
    265     Font.Charset = DEFAULT_CHARSET
    266     Font.Color = clGrayText
    267     Font.Height = -11
    268     Font.Name = 'MS Sans Serif'
    269     Font.Style = []
    270     ItemHeight = 13
    271     ItemTipColor = clWindow
    272     ItemTipEnable = True
    273     ListItemsOnly = True
    274     LongList = True
    275     LookupPiece = 0
    276     MaxLength = 0
    277     ParentFont = False
    278     Pieces = '2'
    279     Sorted = False
    280     SynonymChars = '<>'
    281     TabOrder = 0
    282     OnChange = cboProcSelect
    283     OnNeedData = cboProcNeedData
    284     CharsNeedMatch = 1
    285   end
    286   object cboCategory: TORComboBox [20]
    287     Left = 505
    288     Top = -11
    289     Width = 2
    290     Height = 21
    291     Style = orcsDropDown
    292     AutoSelect = True
    293     Color = clWindow
    294     DropDownCount = 8
    295     ItemHeight = 13
    296     ItemTipColor = clWindow
    297     ItemTipEnable = True
    298     ListItemsOnly = False
    299     LongList = False
    300     LookupPiece = 0
    301     MaxLength = 0
    302     Sorted = False
    303     SynonymChars = '<>'
    304     TabOrder = 15
    305     Visible = False
    306     OnChange = ControlChange
    307     CharsNeedMatch = 1
    308   end
    309   object cboService: TORComboBox [21]
    310     Left = 3
    311     Top = 65
    312     Width = 173
    313     Height = 21
    314     Style = orcsDropDown
    315     AutoSelect = True
    316     Caption = 'Service to perform this procedure'
    317     Color = clWindow
    318     DropDownCount = 8
    319     Enabled = False
    320     Font.Charset = DEFAULT_CHARSET
    321     Font.Color = clGrayText
    322     Font.Height = -11
    323     Font.Name = 'MS Sans Serif'
    324     Font.Style = []
    325     ItemHeight = 13
    326     ItemTipColor = clWindow
    327     ItemTipEnable = True
    328     ListItemsOnly = False
    329     LongList = False
    330     LookupPiece = 0
    331     MaxLength = 0
    332     ParentFont = False
    333     Pieces = '2'
    334     Sorted = False
    335     SynonymChars = '<>'
    336     TabOrder = 1
    337     OnChange = ControlChange
    338     CharsNeedMatch = 1
    339   end
    340   object memComment: TRichEdit [22]
    341     Left = 106
    342     Top = 123
    343     Width = 451
    344     Height = 38
    345     Anchors = [akLeft, akTop, akRight]
    346     PopupMenu = popReason
    347     TabOrder = 11
    348     WantTabs = True
    349     OnChange = ControlChange
    350     OnKeyUp = memCommentKeyUp
    351   end
    352   object pnlMessage: TPanel [23]
    353     Left = 19
    354     Top = 276
    355     Width = 383
     69  object pnlMessage: TPanel [3]
     70    Left = 12
     71    Top = 379
     72    Width = 392
    35673    Height = 44
    35774    Anchors = [akLeft, akRight, akBottom]
    … …  
    35976    BorderStyle = bsSingle
    36077    Caption = 'pnlMessage'
    361     TabOrder = 16
     78    TabOrder = 4
    36279    Visible = False
    36380    object imgMessage: TImage
    … …  
    384101    end
    385102  end
    386   object btnCmtCancel: TButton [24]
    387     Left = 11
    388     Top = 116
    389     Width = 75
    390     Height = 21
    391     Caption = 'Cancellation'
    392     TabOrder = 9
    393     OnClick = btnCmtCancelClick
    394   end
    395   object btnCmtOther: TButton [25]
    396     Left = 11
    397     Top = 139
    398     Width = 75
    399     Height = 21
    400     Caption = 'Other'
    401     TabOrder = 10
    402     OnClick = btnCmtOtherClick
    403   end
    404   object cmdLexSearch: TButton [26]
    405     Left = 509
    406     Top = 94
    407     Width = 49
    408     Height = 21
    409     Anchors = [akTop, akRight]
    410     Caption = 'Lexicon'
    411     TabOrder = 8
    412     OnClick = cmdLexSearchClick
     103  object pnlMain: TPanel [4]
     104    Left = 0
     105    Top = 0
     106    Width = 572
     107    Height = 393
     108    Anchors = [akLeft, akTop, akRight, akBottom]
     109    BevelOuter = bvNone
     110    TabOrder = 1
     111    DesignSize = (
     112      572
     113      393)
     114    object lblProc: TLabel
     115      Left = 3
     116      Top = 7
     117      Width = 49
     118      Height = 13
     119      Caption = 'Procedure'
     120    end
     121    object lblReason: TLabel
     122      Left = 8
     123      Top = 225
     124      Width = 95
     125      Height = 13
     126      Caption = 'Reason for Request'
     127    end
     128    object lblService: TOROffsetLabel
     129      Left = 3
     130      Top = 49
     131      Width = 158
     132      Height = 15
     133      Caption = 'Service to perform this procedure'
     134      HorzOffset = 2
     135      Transparent = False
     136      VertOffset = 2
     137      WordWrap = False
     138    end
     139    object lblComment: TLabel
     140      Left = 8
     141      Top = 166
     142      Width = 74
     143      Height = 13
     144      Caption = 'New Comments'
     145    end
     146    object lblComments: TLabel
     147      Left = 3
     148      Top = 92
     149      Width = 89
     150      Height = 13
     151      Caption = 'Display Comments:'
     152    end
     153    object lblUrgency: TStaticText
     154      Left = 190
     155      Top = 7
     156      Width = 44
     157      Height = 17
     158      Caption = 'Urgency'
     159      TabOrder = 17
     160    end
     161    object lblPlace: TStaticText
     162      Left = 360
     163      Top = 92
     164      Width = 104
     165      Height = 17
     166      Caption = 'Place of Consultation'
     167      TabOrder = 18
     168    end
     169    object lblAttn: TStaticText
     170      Left = 362
     171      Top = 7
     172      Width = 46
     173      Height = 17
     174      Caption = 'Attention'
     175      TabOrder = 19
     176    end
     177    object lblProvDiag: TStaticText
     178      Left = 188
     179      Top = 136
     180      Width = 104
     181      Height = 17
     182      Caption = 'Provisional Diagnosis'
     183      TabOrder = 20
     184    end
     185    object lblInpOutp: TStaticText
     186      Left = 190
     187      Top = 92
     188      Width = 127
     189      Height = 17
     190      Caption = 'Patient will be seen as an:'
     191      TabOrder = 16
     192    end
     193    object memReason: TRichEdit
     194      Left = 8
     195      Top = 241
     196      Width = 560
     197      Height = 151
     198      Anchors = [akLeft, akTop, akRight, akBottom]
     199      Font.Charset = DEFAULT_CHARSET
     200      Font.Color = clWindowText
     201      Font.Height = -11
     202      Font.Name = 'Courier New'
     203      Font.Style = []
     204      ParentFont = False
     205      PopupMenu = popReason
     206      ScrollBars = ssBoth
     207      TabOrder = 14
     208      WantTabs = True
     209      OnChange = ControlChange
     210      OnExit = memReasonExit
     211      OnKeyDown = memReasonKeyDown
     212      OnKeyPress = memReasonKeyPress
     213      OnKeyUp = memCommentKeyUp
     214    end
     215    object cboUrgency: TORComboBox
     216      Left = 190
     217      Top = 22
     218      Width = 165
     219      Height = 21
     220      Style = orcsDropDown
     221      AutoSelect = True
     222      Caption = 'Urgency'
     223      Color = clWindow
     224      DropDownCount = 8
     225      ItemHeight = 13
     226      ItemTipColor = clWindow
     227      ItemTipEnable = True
     228      ListItemsOnly = True
     229      LongList = False
     230      LookupPiece = 0
     231      MaxLength = 0
     232      Pieces = '2'
     233      Sorted = False
     234      SynonymChars = '<>'
     235      TabOrder = 2
     236      OnChange = ControlChange
     237      CharsNeedMatch = 1
     238    end
     239    object radInpatient: TRadioButton
     240      Left = 188
     241      Top = 105
     242      Width = 61
     243      Height = 17
     244      Caption = '&Inpatient'
     245      TabOrder = 8
     246      OnClick = radInpatientClick
     247    end
     248    object radOutpatient: TRadioButton
     249      Left = 255
     250      Top = 105
     251      Width = 73
     252      Height = 17
     253      Caption = '&Outpatient'
     254      TabOrder = 9
     255      OnClick = radOutpatientClick
     256    end
     257    object cboPlace: TORComboBox
     258      Left = 360
     259      Top = 107
     260      Width = 206
     261      Height = 21
     262      Anchors = [akLeft, akTop, akRight]
     263      Style = orcsDropDown
     264      AutoSelect = True
     265      Caption = 'Place of Consultation'
     266      Color = clWindow
     267      DropDownCount = 8
     268      ItemHeight = 13
     269      ItemTipColor = clWindow
     270      ItemTipEnable = True
     271      ListItemsOnly = True
     272      LongList = False
     273      LookupPiece = 0
     274      MaxLength = 0
     275      Pieces = '2'
     276      Sorted = False
     277      SynonymChars = '<>'
     278      TabOrder = 10
     279      OnChange = ControlChange
     280      CharsNeedMatch = 1
     281    end
     282    object txtProvDiag: TCaptionEdit
     283      Left = 188
     284      Top = 149
     285      Width = 324
     286      Height = 21
     287      Anchors = [akLeft, akTop, akRight]
     288      MaxLength = 180
     289      ParentShowHint = False
     290      PopupMenu = mnuPopProvDx
     291      ShowHint = True
     292      TabOrder = 12
     293      OnChange = ControlChange
     294      Caption = 'Provisional Diagnosis'
     295    end
     296    object txtAttn: TORComboBox
     297      Left = 362
     298      Top = 22
     299      Width = 206
     300      Height = 21
     301      Anchors = [akLeft, akTop, akRight]
     302      Style = orcsDropDown
     303      AutoSelect = True
     304      Caption = 'Attention'
     305      Color = clWindow
     306      DropDownCount = 8
     307      ItemHeight = 13
     308      ItemTipColor = clWindow
     309      ItemTipEnable = True
     310      ListItemsOnly = True
     311      LongList = True
     312      LookupPiece = 2
     313      MaxLength = 0
     314      Pieces = '2,3'
     315      Sorted = False
     316      SynonymChars = '<>'
     317      TabOrder = 3
     318      OnChange = ControlChange
     319      OnNeedData = txtAttnNeedData
     320      CharsNeedMatch = 1
     321    end
     322    object cboProc: TORComboBox
     323      Left = 3
     324      Top = 22
     325      Width = 173
     326      Height = 21
     327      Style = orcsDropDown
     328      AutoSelect = True
     329      Caption = 'Procedure'
     330      Color = clWindow
     331      DropDownCount = 8
     332      Enabled = False
     333      Font.Charset = DEFAULT_CHARSET
     334      Font.Color = clGrayText
     335      Font.Height = -11
     336      Font.Name = 'MS Sans Serif'
     337      Font.Style = []
     338      ItemHeight = 13
     339      ItemTipColor = clWindow
     340      ItemTipEnable = True
     341      ListItemsOnly = True
     342      LongList = True
     343      LookupPiece = 0
     344      MaxLength = 0
     345      ParentFont = False
     346      Pieces = '2'
     347      Sorted = False
     348      SynonymChars = '<>'
     349      TabOrder = 0
     350      OnChange = cboProcSelect
     351      OnNeedData = cboProcNeedData
     352      CharsNeedMatch = 1
     353    end
     354    object cboCategory: TORComboBox
     355      Left = 505
     356      Top = -11
     357      Width = 2
     358      Height = 21
     359      Style = orcsDropDown
     360      AutoSelect = True
     361      Color = clWindow
     362      DropDownCount = 8
     363      ItemHeight = 13
     364      ItemTipColor = clWindow
     365      ItemTipEnable = True
     366      ListItemsOnly = False
     367      LongList = False
     368      LookupPiece = 0
     369      MaxLength = 0
     370      Sorted = False
     371      SynonymChars = '<>'
     372      TabOrder = 15
     373      Visible = False
     374      OnChange = ControlChange
     375      CharsNeedMatch = 1
     376    end
     377    object cboService: TORComboBox
     378      Left = 3
     379      Top = 65
     380      Width = 173
     381      Height = 21
     382      Style = orcsDropDown
     383      AutoSelect = True
     384      Caption = 'Service to perform this procedure'
     385      Color = clWindow
     386      DropDownCount = 8
     387      Enabled = False
     388      Font.Charset = DEFAULT_CHARSET
     389      Font.Color = clGrayText
     390      Font.Height = -11
     391      Font.Name = 'MS Sans Serif'
     392      Font.Style = []
     393      ItemHeight = 13
     394      ItemTipColor = clWindow
     395      ItemTipEnable = True
     396      ListItemsOnly = False
     397      LongList = False
     398      LookupPiece = 0
     399      MaxLength = 0
     400      ParentFont = False
     401      Pieces = '2'
     402      Sorted = False
     403      SynonymChars = '<>'
     404      TabOrder = 1
     405      OnChange = ControlChange
     406      CharsNeedMatch = 1
     407    end
     408    object memComment: TRichEdit
     409      Left = 8
     410      Top = 180
     411      Width = 560
     412      Height = 38
     413      Anchors = [akLeft, akTop, akRight]
     414      PopupMenu = popReason
     415      TabOrder = 13
     416      WantTabs = True
     417      OnChange = ControlChange
     418      OnExit = memCommentExit
     419      OnKeyUp = memCommentKeyUp
     420    end
     421    object btnCmtCancel: TButton
     422      Left = 3
     423      Top = 111
     424      Width = 75
     425      Height = 21
     426      Caption = 'Cancellation'
     427      TabOrder = 6
     428      OnClick = btnCmtCancelClick
     429    end
     430    object btnCmtOther: TButton
     431      Left = 84
     432      Top = 111
     433      Width = 75
     434      Height = 21
     435      Caption = 'Other'
     436      TabOrder = 7
     437      OnClick = btnCmtOtherClick
     438    end
     439    object cmdLexSearch: TButton
     440      Left = 516
     441      Top = 149
     442      Width = 49
     443      Height = 21
     444      Anchors = [akTop, akRight]
     445      Caption = 'Lexicon'
     446      TabOrder = 11
     447      OnClick = cmdLexSearchClick
     448    end
     449    object lblEarliest: TStaticText
     450      Left = 190
     451      Top = 49
     452      Width = 121
     453      Height = 17
     454      Caption = 'Earliest appropriate date:'
     455      TabOrder = 21
     456    end
     457    object lblLatest: TStaticText
     458      Left = 361
     459      Top = 49
     460      Width = 116
     461      Height = 17
     462      Caption = 'Latest appropriate date:'
     463      TabOrder = 22
     464      Visible = False
     465    end
     466    object calEarliest: TORDateBox
     467      Left = 190
     468      Top = 65
     469      Width = 164
     470      Height = 21
     471      TabOrder = 4
     472      OnExit = calEarliestExit
     473      DateOnly = True
     474      RequireTime = False
     475    end
     476    object calLatest: TORDateBox
     477      Left = 362
     478      Top = 65
     479      Width = 204
     480      Height = 21
     481      Anchors = [akLeft, akTop, akRight]
     482      TabOrder = 5
     483      Visible = False
     484      OnExit = calLatestExit
     485      DateOnly = True
     486      RequireTime = False
     487    end
    413488  end
    414489  inherited amgrMain: TVA508AccessibilityManager
    415490    Data = (
    416491      (
     492        'Component = cmdAccept'
     493        'Status = stsDefault')
     494      (
     495        'Component = cmdQuit'
     496        'Status = stsDefault')
     497      (
     498        'Component = pnlMessage'
     499        'Status = stsDefault')
     500      (
     501        'Component = memMessage'
     502        'Status = stsDefault')
     503      (
     504        'Component = frmEditProc'
     505        'Status = stsDefault')
     506      (
     507        'Component = pnlMain'
     508        'Status = stsDefault')
     509      (
    417510        'Component = lblUrgency'
    418511        'Status = stsDefault')
    … …  
    433526        'Status = stsDefault')
    434527      (
    435         'Component = cmdAccept'
    436         'Status = stsDefault')
    437       (
    438         'Component = cmdQuit'
    439         'Status = stsDefault')
    440       (
    441528        'Component = cboUrgency'
    442529        'Status = stsDefault')
    … …  
    469556        'Status = stsDefault')
    470557      (
    471         'Component = pnlMessage'
    472         'Status = stsDefault')
    473       (
    474         'Component = memMessage'
    475         'Status = stsDefault')
    476       (
    477558        'Component = btnCmtCancel'
    478559        'Status = stsDefault')
    … …  
    484565        'Status = stsDefault')
    485566      (
    486         'Component = frmEditProc'
     567        'Component = lblEarliest'
     568        'Status = stsDefault')
     569      (
     570        'Component = lblLatest'
     571        'Status = stsDefault')
     572      (
     573        'Component = calEarliest'
     574        'Status = stsDefault')
     575      (
     576        'Component = calLatest'
     577        'Status = stsDefault')
     578      (
     579        'Component = pnlCombatVet'
     580        'Status = stsDefault')
     581      (
     582        'Component = txtCombatVet'
    487583        'Status = stsDefault'))
    488584  end
    489585  object mnuPopProvDx: TPopupMenu
    490     Left = 353
    491     Top = 77
     586    Left = 351
     587    Top = 132
    492588    object mnuPopProvDxDelete: TMenuItem
    493589      Caption = 'Delete diagnosis'
    … …  
    497593  object popReason: TPopupMenu
    498594    OnPopup = popReasonPopup
    499     Left = 411
    500     Top = 169
     595    Left = 539
     596    Top = 361
    501597    object popReasonCut: TMenuItem
    502598      Caption = 'Cu&t'

  • cprs/trunk/CPRS-Chart/Consults/fEditProc.pas

    r829 r1679  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
    8   Menus, fBase508Form, VA508AccessibilityManager;
     8  Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form;
    99
    1010type
    11   TfrmEditProc = class(TfrmBase508Form)
     11  TfrmEditProc = class(TfrmAutoSz)
    1212    cmdAccept: TButton;
    1313    cmdQuit: TButton;
     14    pnlMessage: TPanel;
     15    imgMessage: TImage;
     16    memMessage: TRichEdit;
     17    pnlMain: TPanel;
     18    lblProc: TLabel;
     19    lblReason: TLabel;
     20    lblService: TOROffsetLabel;
     21    lblComment: TLabel;
     22    lblComments: TLabel;
     23    lblUrgency: TStaticText;
     24    lblPlace: TStaticText;
     25    lblAttn: TStaticText;
     26    lblProvDiag: TStaticText;
     27    lblInpOutp: TStaticText;
     28    memReason: TRichEdit;
    1429    cboUrgency: TORComboBox;
    1530    radInpatient: TRadioButton;
    … …  
    1833    txtProvDiag: TCaptionEdit;
    1934    txtAttn: TORComboBox;
    20     lblProc: TLabel;
    2135    cboProc: TORComboBox;
    22     lblReason: TLabel;
    23     lblUrgency: TStaticText;
    24     lblPlace: TStaticText;
    25     lblAttn: TStaticText;
    26     lblProvDiag: TStaticText;
    2736    cboCategory: TORComboBox;
    2837    cboService: TORComboBox;
    29     lblService: TOROffsetLabel;
    3038    memComment: TRichEdit;
    31     lblComment: TLabel;
    32     lblComments: TLabel;
    33     pnlMessage: TPanel;
    34     imgMessage: TImage;
    35     memMessage: TRichEdit;
    3639    btnCmtCancel: TButton;
    3740    btnCmtOther: TButton;
     41    cmdLexSearch: TButton;
     42    lblEarliest: TStaticText;
     43    lblLatest: TStaticText;
     44    calEarliest: TORDateBox;
     45    calLatest: TORDateBox;
    3846    mnuPopProvDx: TPopupMenu;
    3947    mnuPopProvDxDelete: TMenuItem;
    40     cmdLexSearch: TButton;
    41     lblInpOutp: TStaticText;
    42     memReason: TRichEdit;
    4348    popReason: TPopupMenu;
    4449    popReasonCut: TMenuItem;
    … …  
    4752    popReasonPaste2: TMenuItem;
    4853    popReasonReformat: TMenuItem;
     54    pnlCombatVet: TPanel;
     55    txtCombatVet: TVA508StaticText;
    4956    procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
    5057      Direction, InsertAt: Integer);
    … …  
    7481      Shift: TShiftState);
    7582    procedure memReasonKeyPress(Sender: TObject; var Key: Char);
     83    procedure calEarliestExit(Sender: TObject);
     84    procedure calLatestExit(Sender: TObject);
     85    procedure memCommentExit(Sender: TObject);
    7686  private
    7787    FLastProcID: string;
    … …  
    8090    FEditCtrl: TCustomEdit;
    8191    FNavigatingTab: boolean;
     92    FEarliestDate: TFMDateTime;
     93    //FLatestDate: TFMDateTime;
    8294    procedure SetProvDiagPromptingMode;
     95    procedure SetUpCombatVet;
    8396  protected
    8497    procedure InitDialog;
    … …  
    117130                       'Another code must be selected';
    118131  TC_INACTIVE_CODE   = 'Inactive ICD Code';
     132  TX_PAST_DATE       = 'Earliest appropriate date must be today or later.';
     133  TX_BAD_DATES       = 'Latest appropriate date must be equal to or later than earliest date.';
    119134
    120135function EditResubmitProcedure(FontSize: Integer; ConsultIEN: integer): boolean;
    … …  
    165180  i: integer;
    166181begin
     182  if FChanging then exit;
    167183  FChanging := True;
    168184  Defaults := TStringList.Create;
    … …  
    199215  with cboUrgency do for i := 0 to Items.Count-1 do
    200216    if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i;
     217  calEarliest.FMDateTime := OldRec.EarliestDate;
     218  FEarliestDate := OldRec.EarliestDate;
     219  //calLatest.FMDateTime := OldRec.LatestDate;
     220  //FLatestDate := OldRec.LatestDate;
    201221  txtProvDiag.Text := OldRec.ProvDiagnosis;
    202222  ProvDx.Code := OldRec.ProvDxCode;
    … …  
    211231  memComment.Clear ;
    212232  SetProvDiagPromptingMode;
     233    if (patient.CombatVet.IsEligible = True) then
     234   begin
     235    SetUpCombatVet;
     236   end
     237   else
     238    begin
     239      txtCombatVet.Enabled := False;
     240      pnlCombatVet.SendToBack;
     241    end;
    213242  FChanging := False;
    214243  StatusText('');
    … …  
    238267  if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
    239268    SetError(TX_INACTIVE_CODE);
     269  if calEarliest.FMDateTime < FMToday     then SetError(TX_PAST_DATE);
     270  //if calLatest.FMDateTime < FMToday       then SetError(TX_PAST_DATE);
     271  //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
    240272end;
    241273
    … …  
    245277  inherited;
    246278  txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
     279end;
     280
     281procedure TfrmEditProc.calEarliestExit(Sender: TObject);
     282begin
     283  inherited;
     284  FEarliestDate := calEarliest.FMDateTime;
     285  ControlChange(Self);
     286end;
     287
     288procedure TfrmEditProc.calLatestExit(Sender: TObject);
     289begin
     290  inherited;
     291  //FLatestDate := calLatest.FMDateTime;
     292  //ControlChange(Self);
    247293end;
    248294
    … …  
    323369         end;
    324370
     371     if FEarliestDate > 0 then
     372     begin
     373       if FEarliestDate <> OldRec.EarliestDate then
     374         EarliestDate := FEarliestDate
     375       else
     376         EarliestDate := 0;
     377     end;
     378
     379(*     if FLatestDate > 0 then
     380     begin
     381       if FLatestDate <> OldRec.LatestDate then
     382         LatestDate := FLatestDate
     383       else
     384         LatestDate := 0;
     385     end;*)
    325386
    326387     with cboPlace do if Length(ItemID) > 0 then
    … …  
    433494end;
    434495
     496procedure TfrmEditProc.SetUpCombatVet;
     497begin
     498  pnlCombatVet.BringToFront;
     499  txtCombatVet.Enabled := True;
     500  txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
     501  pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
     502  pnlMain.Anchors := [akLeft, akTop, akRight];
     503  self.Height := self.Height + pnlCombatVet.Height;
     504  pnlMain.Anchors := [akLeft, akTop, akRight, akBottom];
     505  ActiveControl := txtCombatVet;
     506end;
     507
    435508procedure TfrmEditProc.cboProcSelect(Sender: TObject);
    436509begin
    … …  
    454527            InfoBox('There are no services defined for this procedure.',
    455528              'Information', MB_OK or MB_ICONINFORMATION);
    456             cboProc.ItemIndex := -1;
     529            //cboProc.ItemIndex := -1;
    457530            InitDialog;
    458531            Exit ;
    … …  
    652725
    653726
     727procedure TfrmEditProc.memCommentExit(Sender: TObject);
     728//added OnExit code for CQ17822 WAT
     729var
     730  AStringList: TStringList;
     731begin
     732  inherited;
     733  AStringList := TStringList.Create;
     734  try
     735    //QuickCopy(memComment, AStringList);
     736    AStringList.Text := memComment.Text;
     737    LimitStringLength(AStringList, 74);
     738    //QuickCopy(AstringList, memComment);
     739    memComment.Text := AStringList.Text;
     740    ControlChange(Self);
     741  finally
     742    AStringList.Free;
     743  end;
     744end;
     745
    654746procedure TfrmEditProc.memCommentKeyUp(Sender: TObject; var Key: Word;
    655747  Shift: TShiftState);
    … …  
    671763  Shift: TShiftState);
    672764begin
    673   //The navigating tab controls were inadvertantently adding tab characters
     765  //The navigating tab controls were inadvertently adding tab characters
    674766  //This should fix it
    675767  FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);

  • cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm

    r829 r1679  
    44  Top = 203
    55  Width = 606
    6   Height = 376
     6  Height = 455
    77  HorzScrollBar.Range = 590
    88  VertScrollBar.Range = 340
    99  Caption = 'Order a Consult'
    10   Constraints.MinHeight = 376
    11   Constraints.MinWidth = 606
     10  Constraints.MinHeight = 442
     11  Constraints.MinWidth = 590
    1212  Font.Charset = ANSI_CHARSET
    1313  ExplicitWidth = 606
    14   ExplicitHeight = 376
     14  ExplicitHeight = 455
    1515  PixelsPerInch = 96
    1616  TextHeight = 13
    17   object lblService: TLabel [0]
    18     Left = 1
    19     Top = 2
    20     Width = 134
    21     Height = 13
    22     Caption = 'Consult to Service/Specialty'
    23   end
    24   object lblProvDiag: TLabel [1]
    25     Left = 309
    26     Top = 81
    27     Width = 100
    28     Height = 13
    29     Anchors = [akTop, akRight]
    30     Caption = 'Provisional Diagnosis'
    31   end
    32   object lblUrgency: TLabel [2]
    33     Left = 309
    34     Top = 2
    35     Width = 40
    36     Height = 13
    37     Anchors = [akTop, akRight]
    38     Caption = 'Urgency'
    39   end
    40   object lblPlace: TLabel [3]
    41     Left = 454
    42     Top = 43
    43     Width = 100
    44     Height = 13
    45     Anchors = [akTop, akRight]
    46     Caption = 'Place of Consultation'
    47   end
    48   object lblAttn: TLabel [4]
    49     Left = 454
    50     Top = 2
    51     Width = 42
    52     Height = 13
    53     Anchors = [akTop, akRight]
    54     Caption = 'Attention'
    55   end
    56   object pnlReason: TPanel [5]
    57     Left = 3
    58     Top = 128
    59     Width = 585
    60     Height = 161
    61     Anchors = [akLeft, akTop, akRight]
    62     BevelOuter = bvNone
    63     TabOrder = 10
    64     object lblReason: TLabel
    65       Left = 0
    66       Top = 0
    67       Width = 585
    68       Height = 13
    69       Align = alTop
    70       Caption = 'Reason for Request'
    71       ExplicitWidth = 95
    72     end
    73     object memReason: TRichEdit
    74       Left = 0
    75       Top = 13
    76       Width = 585
    77       Height = 148
     17  object pnlCombatVet: TPanel [0]
     18    Left = 0
     19    Top = 0
     20    Width = 598
     21    Height = 25
     22    Align = alTop
     23    BevelOuter = bvLowered
     24    Font.Charset = DEFAULT_CHARSET
     25    Font.Color = clWindowText
     26    Font.Height = -11
     27    Font.Name = 'MS Sans Serif'
     28    Font.Style = []
     29    ParentFont = False
     30    TabOrder = 0
     31    object txtCombatVet: TVA508StaticText
     32      Name = 'txtCombatVet'
     33      Left = 1
     34      Top = 1
     35      Width = 596
     36      Height = 23
    7837      Align = alClient
    79       Font.Charset = ANSI_CHARSET
    80       Font.Color = clWindowText
    81       Font.Height = -11
    82       Font.Name = 'Courier New'
    83       Font.Style = []
    84       Constraints.MinHeight = 40
    85       ParentFont = False
    86       PopupMenu = popReason
    87       ScrollBars = ssBoth
     38      Alignment = taCenter
     39      BevelOuter = bvNone
     40      Enabled = False
    8841      TabOrder = 0
    89       WantTabs = True
    90       OnChange = ControlChange
    91       OnExit = memReasonExit
    92       OnKeyDown = memReasonKeyDown
    93       OnKeyPress = memReasonKeyPress
    94       OnKeyUp = memReasonKeyUp
     42      ShowAccelChar = True
    9543    end
    9644  end
    9745  inherited memOrder: TCaptionMemo
    9846    Left = 3
    99     Top = 305
     47    Top = 384
    10048    Width = 417
    10149    Height = 41
    102     TabStop = True
    10350    Anchors = [akLeft, akBottom]
    10451    Lines.Strings = (
    … …  
    10754      '--------------------------------'
    10855      'An order message may be displayed here.')
    109     TabOrder = 11
     56    TabOrder = 2
    11057    ExplicitLeft = 3
    111     ExplicitTop = 305
     58    ExplicitTop = 384
    11259    ExplicitWidth = 417
    11360    ExplicitHeight = 41
    11461  end
    115   object cboService: TORComboBox [7]
     62  object pnlMain: TPanel [2]
    11663    Left = 0
    117     Top = 16
    118     Width = 274
    119     Height = 113
    120     Anchors = [akLeft, akTop, akRight]
    121     Style = orcsSimple
    122     AutoSelect = True
    123     Caption = 'Consult to Service/Specialty'
    124     Color = clWindow
    125     DropDownCount = 12
    126     ItemHeight = 13
    127     ItemTipColor = clWindow
    128     ItemTipEnable = True
    129     ListItemsOnly = True
    130     LongList = False
    131     LookupPiece = 0
    132     MaxLength = 0
    133     Pieces = '2'
    134     Sorted = False
    135     SynonymChars = '<>'
    136     TabOrder = 0
    137     TabStop = True
    138     OnChange = ControlChange
    139     OnClick = cboServiceSelect
    140     OnExit = cboServiceExit
    141     OnKeyDown = cboServiceKeyDown
    142     OnKeyUp = cboServiceKeyUp
    143     CharsNeedMatch = 1
    144   end
    145   object cboUrgency: TORComboBox [8]
    146     Left = 309
    147     Top = 16
    148     Width = 133
    149     Height = 21
    150     Anchors = [akTop, akRight]
    151     Style = orcsDropDown
    152     AutoSelect = True
    153     Color = clWindow
    154     DropDownCount = 8
    155     ItemHeight = 13
    156     ItemTipColor = clWindow
    157     ItemTipEnable = True
    158     ListItemsOnly = True
    159     LongList = False
    160     LookupPiece = 0
    161     MaxLength = 0
    162     Pieces = '2'
    163     Sorted = False
    164     SynonymChars = '<>'
     64    Top = 0
     65    Width = 598
     66    Height = 380
     67    Anchors = [akLeft, akTop, akRight, akBottom]
     68    BevelOuter = bvNone
     69    TabOrder = 1
     70    DesignSize = (
     71      598
     72      380)
     73    object lblService: TLabel
     74      Left = 1
     75      Top = 2
     76      Width = 134
     77      Height = 13
     78      Caption = 'Consult to Service/Specialty'
     79    end
     80    object lblProvDiag: TLabel
     81      Left = 312
     82      Top = 138
     83      Width = 100
     84      Height = 13
     85      Anchors = [akTop, akRight]
     86      Caption = 'Provisional Diagnosis'
     87    end
     88    object lblUrgency: TLabel
     89      Left = 309
     90      Top = 2
     91      Width = 40
     92      Height = 13
     93      Anchors = [akTop, akRight]
     94      Caption = 'Urgency'
     95    end
     96    object lblPlace: TLabel
     97      Left = 457
     98      Top = 100
     99      Width = 100
     100      Height = 13
     101      Anchors = [akTop, akRight]
     102      Caption = 'Place of Consultation'
     103    end
     104    object lblAttn: TLabel
     105      Left = 454
     106      Top = 2
     107      Width = 42
     108      Height = 13
     109      Anchors = [akTop, akRight]
     110      Caption = 'Attention'
     111    end
     112    object lblLatest: TStaticText
     113      Left = 454
     114      Top = 43
     115      Width = 116
     116      Height = 17
     117      Anchors = [akTop, akRight]
     118      Caption = 'Latest appropriate date:'
     119      TabOrder = 17
     120      Visible = False
     121    end
     122    object lblEarliest: TStaticText
     123      Left = 309
     124      Top = 43
     125      Width = 121
     126      Height = 17
     127      Anchors = [akTop, akRight]
     128      Caption = 'Earliest appropriate date:'
     129      TabOrder = 14
     130    end
     131    object pnlReason: TPanel
     132      Left = 3
     133      Top = 176
     134      Width = 587
     135      Height = 179
     136      Anchors = [akLeft, akTop, akRight]
     137      BevelOuter = bvNone
     138      Constraints.MinHeight = 53
     139      TabOrder = 13
     140      object lblReason: TLabel
     141        Left = 0
     142        Top = 0
     143        Width = 587
     144        Height = 13
     145        Align = alTop
     146        Caption = 'Reason for Request'
     147        Constraints.MinHeight = 13
     148        ExplicitWidth = 95
     149      end
     150      object memReason: TRichEdit
     151        Left = 0
     152        Top = 13
     153        Width = 587
     154        Height = 166
     155        Align = alClient
     156        Font.Charset = ANSI_CHARSET
     157        Font.Color = clWindowText
     158        Font.Height = -11
     159        Font.Name = 'Courier New'
     160        Font.Style = []
     161        Constraints.MinHeight = 40
     162        MaxLength = 2147483645
     163        ParentFont = False
     164        PopupMenu = popReason
     165        ScrollBars = ssBoth
     166        TabOrder = 0
     167        WantTabs = True
     168        OnChange = ControlChange
     169        OnExit = memReasonExit
     170        OnKeyDown = memReasonKeyDown
     171        OnKeyPress = memReasonKeyPress
     172        OnKeyUp = memReasonKeyUp
     173      end
     174    end
     175    object cboService: TORComboBox
     176      Left = 0
     177      Top = 16
     178      Width = 274
     179      Height = 154
     180      Anchors = [akLeft, akTop, akRight]
     181      Style = orcsSimple
     182      AutoSelect = True
     183      Caption = 'Consult to Service/Specialty'
     184      Color = clWindow
     185      DropDownCount = 16
     186      ItemHeight = 13
     187      ItemTipColor = clWindow
     188      ItemTipEnable = True
     189      ListItemsOnly = True
     190      LongList = False
     191      LookupPiece = 0
     192      MaxLength = 0
     193      Pieces = '2'
     194      Sorted = False
     195      SynonymChars = '<>'
     196      TabOrder = 0
     197      OnChange = ControlChange
     198      OnClick = cboServiceSelect
     199      OnExit = cboServiceExit
     200      OnKeyDown = cboServiceKeyDown
     201      OnKeyUp = cboServiceKeyUp
     202      CharsNeedMatch = 1
     203    end
     204    object cboUrgency: TORComboBox
     205      Left = 309
     206      Top = 16
     207      Width = 133
     208      Height = 21
     209      Anchors = [akTop, akRight]
     210      Style = orcsDropDown
     211      AutoSelect = True
     212      Caption = 'Urgency'
     213      Color = clWindow
     214      DropDownCount = 8
     215      ItemHeight = 13
     216      ItemTipColor = clWindow
     217      ItemTipEnable = True
     218      ListItemsOnly = True
     219      LongList = False
     220      LookupPiece = 0
     221      MaxLength = 0
     222      Pieces = '2'
     223      Sorted = False
     224      SynonymChars = '<>'
     225      TabOrder = 4
     226      TabStop = True
     227      OnChange = ControlChange
     228      CharsNeedMatch = 1
     229    end
     230    object cboPlace: TORComboBox
     231      Left = 457
     232      Top = 113
     233      Width = 136
     234      Height = 21
     235      Anchors = [akTop, akRight]
     236      Style = orcsDropDown
     237      AutoSelect = True
     238      Caption = 'Place of Consultation'
     239      Color = clWindow
     240      DropDownCount = 8
     241      ItemHeight = 13
     242      ItemTipColor = clWindow
     243      ItemTipEnable = True
     244      ListItemsOnly = True
     245      LongList = False
     246      LookupPiece = 0
     247      MaxLength = 0
     248      Pieces = '2'
     249      Sorted = False
     250      SynonymChars = '<>'
     251      TabOrder = 9
     252      OnChange = ControlChange
     253      CharsNeedMatch = 1
     254    end
     255    object txtProvDiag: TCaptionEdit
     256      Left = 312
     257      Top = 151
     258      Width = 223
     259      Height = 21
     260      Anchors = [akTop, akRight]
     261      MaxLength = 180
     262      ParentShowHint = False
     263      PopupMenu = mnuPopProvDx
     264      ShowHint = True
     265      TabOrder = 11
     266      OnChange = txtProvDiagChange
     267      Caption = 'Provisional Diagnosis'
     268    end
     269    object txtAttn: TORComboBox
     270      Left = 454
     271      Top = 16
     272      Width = 136
     273      Height = 21
     274      Anchors = [akTop, akRight]
     275      Style = orcsDropDown
     276      AutoSelect = True
     277      Caption = 'Attention'
     278      Color = clWindow
     279      DropDownCount = 8
     280      ItemHeight = 13
     281      ItemTipColor = clWindow
     282      ItemTipEnable = True
     283      ListItemsOnly = True
     284      LongList = True
     285      LookupPiece = 2
     286      MaxLength = 0
     287      Pieces = '2,3'
     288      Sorted = False
     289      SynonymChars = '<>'
     290      TabOrder = 5
     291      OnChange = ControlChange
     292      OnNeedData = txtAttnNeedData
     293      CharsNeedMatch = 1
     294    end
     295    object treService: TORTreeView
     296      Left = 0
     297      Top = 38
     298      Width = 298
     299      Height = 220
     300      Anchors = [akLeft, akTop, akRight, akBottom]
     301      Font.Charset = DEFAULT_CHARSET
     302      Font.Color = clWindowText
     303      Font.Height = -9
     304      Font.Name = 'MS Sans Serif'
     305      Font.Style = []
     306      HideSelection = False
     307      Indent = 19
     308      ParentFont = False
     309      ReadOnly = True
     310      TabOrder = 3
     311      Visible = False
     312      OnChange = treServiceChange
     313      OnCollapsing = treServiceCollapsing
     314      OnEnter = treServiceEnter
     315      OnExit = treServiceExit
     316      OnKeyDown = treServiceKeyDown
     317      OnKeyUp = treServiceKeyUp
     318      OnMouseDown = treServiceMouseDown
     319      Caption = 'object lblService: TLabel'
     320      NodePiece = 0
     321    end
     322    object cboCategory: TORComboBox
     323      Left = 225
     324      Top = -5
     325      Width = 5
     326      Height = 21
     327      Style = orcsDropDown
     328      AutoSelect = True
     329      Color = clWindow
     330      DropDownCount = 8
     331      ItemHeight = 13
     332      ItemTipColor = clWindow
     333      ItemTipEnable = True
     334      ListItemsOnly = False
     335      LongList = False
     336      LookupPiece = 0
     337      MaxLength = 0
     338      Sorted = False
     339      SynonymChars = '<>'
     340      TabOrder = 18
     341      Visible = False
     342      CharsNeedMatch = 1
     343    end
     344    object pnlServiceTreeButton: TKeyClickPanel
     345      Left = 274
     346      Top = 14
     347      Width = 26
     348      Height = 26
     349      Hint = 'View services/specialties hierarchically'
     350      Anchors = [akTop, akRight]
     351      BevelOuter = bvNone
     352      BevelWidth = 2
     353      Caption = 'View services/specialties hierarchically'
     354      Font.Charset = ANSI_CHARSET
     355      Font.Color = clBtnFace
     356      Font.Height = -11
     357      Font.Name = 'MS Sans Serif'
     358      Font.Style = []
     359      ParentFont = False
     360      TabOrder = 2
     361      TabStop = True
     362      OnClick = btnServiceTreeClick
     363      OnEnter = pnlServiceTreeButtonEnter
     364      OnExit = pnlServiceTreeButtonExit
     365      object btnServiceTree: TSpeedButton
     366        Left = 2
     367        Top = 2
     368        Width = 22
     369        Height = 22
     370        Glyph.Data = {
     371          26050000424D26050000000000003604000028000000100000000F0000000100
     372          080000000000F000000000000000000000000001000000010000000000000000
     373          80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA
     374          A6000020400000206000002080000020A0000020C0000020E000004000000040
     375          20000040400000406000004080000040A0000040C0000040E000006000000060
     376          20000060400000606000006080000060A0000060C0000060E000008000000080
     377          20000080400000806000008080000080A0000080C0000080E00000A0000000A0
     378          200000A0400000A0600000A0800000A0A00000A0C00000A0E00000C0000000C0
     379          200000C0400000C0600000C0800000C0A00000C0C00000C0E00000E0000000E0
     380          200000E0400000E0600000E0800000E0A00000E0C00000E0E000400000004000
     381          20004000400040006000400080004000A0004000C0004000E000402000004020
     382          20004020400040206000402080004020A0004020C0004020E000404000004040
     383          20004040400040406000404080004040A0004040C0004040E000406000004060
     384          20004060400040606000406080004060A0004060C0004060E000408000004080
     385          20004080400040806000408080004080A0004080C0004080E00040A0000040A0
     386          200040A0400040A0600040A0800040A0A00040A0C00040A0E00040C0000040C0
     387          200040C0400040C0600040C0800040C0A00040C0C00040C0E00040E0000040E0
     388          200040E0400040E0600040E0800040E0A00040E0C00040E0E000800000008000
     389          20008000400080006000800080008000A0008000C0008000E000802000008020
     390          20008020400080206000802080008020A0008020C0008020E000804000008040
     391          20008040400080406000804080008040A0008040C0008040E000806000008060
     392          20008060400080606000806080008060A0008060C0008060E000808000008080
     393          20008080400080806000808080008080A0008080C0008080E00080A0000080A0
     394          200080A0400080A0600080A0800080A0A00080A0C00080A0E00080C0000080C0
     395          200080C0400080C0600080C0800080C0A00080C0C00080C0E00080E0000080E0
     396          200080E0400080E0600080E0800080E0A00080E0C00080E0E000C0000000C000
     397          2000C0004000C0006000C0008000C000A000C000C000C000E000C0200000C020
     398          2000C0204000C0206000C0208000C020A000C020C000C020E000C0400000C040
     399          2000C0404000C0406000C0408000C040A000C040C000C040E000C0600000C060
     400          2000C0604000C0606000C0608000C060A000C060C000C060E000C0800000C080
     401          2000C0804000C0806000C0808000C080A000C080C000C080E000C0A00000C0A0
     402          2000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0E000C0C00000C0C0
     403          2000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0A000808080000000
     404          FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFF0700
     405          07FFFFFFFFFFFFFFFFFFFFA4A407000400FF040404040404FFFFFFA4FFFF0700
     406          07FFFFFFFFFFFFFFFFFFFFA4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA4FFFFFFFF
     407          FFFF070007FFFFFFFFFFFFA4FFFFFFA4A407000400FF04040404FFA4FFFFFFA4
     408          FFFF070007FFFFFFFFFFFFA4FFFFFF07FFFFFFFFFFFFFFFFFFFFFFA4FFFF0700
     409          07FFFFFFFFFFFFFFFFFFFFA4A407000400FF0404040404FFFFFFFFA4FFFF0700
     410          07FFFFFFFFFFFFFFFFFFFF07FFFFFFFFFFFFFFFFFFFFFFFFFFFF070007FFFFFF
     411          FFFFFFFFFFFFFFFFFFFF00FB00FF0404040404FFFFFFFFFFFFFF070007FFFFFF
     412          FFFFFFFFFFFFFFFFFFFF}
     413        Margin = 0
     414        OnClick = btnServiceTreeClick
     415      end
     416    end
     417    object gbInptOpt: TGroupBox
     418      Left = 309
     419      Top = 92
     420      Width = 140
     421      Height = 45
     422      Anchors = [akTop, akRight]
     423      Caption = 'Patient will be seen as an:'
     424      TabOrder = 8
     425      object radInpatient: TRadioButton
     426        Left = 3
     427        Top = 20
     428        Width = 61
     429        Height = 13
     430        Caption = '&Inpatient'
     431        TabOrder = 1
     432        OnClick = radInpatientClick
     433      end
     434      object radOutpatient: TRadioButton
     435        Left = 67
     436        Top = 20
     437        Width = 70
     438        Height = 13
     439        Caption = '&Outpatient'
     440        TabOrder = 0
     441        OnClick = radOutpatientClick
     442      end
     443    end
     444    object btnDiagnosis: TButton
     445      Left = 541
     446      Top = 151
     447      Width = 49
     448      Height = 21
     449      Anchors = [akTop, akRight]
     450      Caption = 'Diagnosis'
     451      TabOrder = 10
     452      OnClick = btnDiagnosisClick
     453    end
     454    object cmdLexSearch: TButton
     455      Left = 541
     456      Top = 151
     457      Width = 49
     458      Height = 21
     459      Anchors = [akTop, akRight]
     460      Caption = 'Lexicon'
     461      TabOrder = 12
     462      OnClick = cmdLexSearchClick
     463    end
     464    object calEarliest: TORDateBox
     465      Left = 309
     466      Top = 57
     467      Width = 133
     468      Height = 21
     469      Anchors = [akTop, akRight]
     470      TabOrder = 6
     471      OnChange = ControlChange
     472      DateOnly = True
     473      RequireTime = False
     474    end
     475    object calLatest: TORDateBox
     476      Left = 454
     477      Top = 57
     478      Width = 136
     479      Height = 21
     480      Anchors = [akTop, akRight]
     481      TabOrder = 7
     482      Visible = False
     483      OnChange = ControlChange
     484      DateOnly = True
     485      RequireTime = False
     486    end
     487    object servicelbl508: TVA508StaticText
     488      Name = 'servicelbl508'
     489      Left = 151
     490      Top = 1
     491      Width = 106
     492      Height = 15
     493      Alignment = taLeftJustify
     494      Caption = 'service (for screen R.)'
     495      Enabled = False
     496      TabOrder = 1
     497      Visible = False
     498      ShowAccelChar = True
     499    end
     500  end
     501  inherited cmdAccept: TButton
     502    Left = 427
     503    Top = 394
     504    Anchors = [akLeft, akBottom]
    165505    TabOrder = 3
    166     TabStop = True
    167     OnChange = ControlChange
    168     CharsNeedMatch = 1
    169   end
    170   object cboPlace: TORComboBox [9]
    171     Left = 454
    172     Top = 56
    173     Width = 136
    174     Height = 21
    175     Anchors = [akTop, akRight]
    176     Style = orcsDropDown
    177     AutoSelect = True
    178     Color = clWindow
    179     DropDownCount = 8
    180     ItemHeight = 13
    181     ItemTipColor = clWindow
    182     ItemTipEnable = True
    183     ListItemsOnly = True
    184     LongList = False
    185     LookupPiece = 0
    186     MaxLength = 0
    187     Pieces = '2'
    188     Sorted = False
    189     SynonymChars = '<>'
    190     TabOrder = 6
    191     OnChange = ControlChange
    192     CharsNeedMatch = 1
    193   end
    194   object txtProvDiag: TCaptionEdit [10]
    195     Left = 309
    196     Top = 94
    197     Width = 231
    198     Height = 21
    199     Anchors = [akTop, akRight]
    200     MaxLength = 180
    201     ParentShowHint = False
    202     PopupMenu = mnuPopProvDx
    203     ShowHint = True
    204     TabOrder = 8
    205     OnChange = txtProvDiagChange
    206   end
    207   object txtAttn: TORComboBox [11]
    208     Left = 454
    209     Top = 16
    210     Width = 136
    211     Height = 21
    212     Anchors = [akTop, akRight]
    213     Style = orcsDropDown
    214     AutoSelect = True
    215     Color = clWindow
    216     DropDownCount = 8
    217     ItemHeight = 13
    218     ItemTipColor = clWindow
    219     ItemTipEnable = True
    220     ListItemsOnly = True
    221     LongList = True
    222     LookupPiece = 2
    223     MaxLength = 0
    224     Pieces = '2,3'
    225     Sorted = False
    226     SynonymChars = '<>'
    227     TabOrder = 4
    228     OnChange = ControlChange
    229     OnNeedData = txtAttnNeedData
    230     CharsNeedMatch = 1
    231   end
    232   object treService: TORTreeView [12]
    233     Left = 0
    234     Top = 38
    235     Width = 298
    236     Height = 220
    237     Anchors = [akLeft, akTop, akRight, akBottom]
    238     Font.Charset = DEFAULT_CHARSET
    239     Font.Color = clWindowText
    240     Font.Height = -9
    241     Font.Name = 'MS Sans Serif'
    242     Font.Style = []
    243     HideSelection = False
    244     Indent = 19
    245     ParentFont = False
    246     ReadOnly = True
    247     TabOrder = 2
    248     Visible = False
    249     OnChange = treServiceChange
    250     OnCollapsing = treServiceCollapsing
    251     OnEnter = treServiceEnter
    252     OnExit = treServiceExit
    253     OnKeyDown = treServiceKeyDown
    254     OnKeyUp = treServiceKeyUp
    255     OnMouseDown = treServiceMouseDown
    256     NodePiece = 0
    257   end
    258   object cboCategory: TORComboBox [13]
    259     Left = 225
    260     Top = -5
    261     Width = 5
    262     Height = 21
    263     Style = orcsDropDown
    264     AutoSelect = True
    265     Color = clWindow
    266     DropDownCount = 8
    267     ItemHeight = 13
    268     ItemTipColor = clWindow
    269     ItemTipEnable = True
    270     ListItemsOnly = False
    271     LongList = False
    272     LookupPiece = 0
    273     MaxLength = 0
    274     Sorted = False
    275     SynonymChars = '<>'
    276     TabOrder = 15
    277     Visible = False
    278     CharsNeedMatch = 1
    279   end
    280   object pnlServiceTreeButton: TKeyClickPanel [14]
    281     Left = 274
    282     Top = 14
    283     Width = 26
    284     Height = 26
    285     Hint = 'View services/specialties hierarchically'
    286     Anchors = [akTop, akRight]
    287     BevelOuter = bvNone
    288     BevelWidth = 2
    289     Caption = 'View services/specialties hierarchically'
    290     Font.Charset = ANSI_CHARSET
    291     Font.Color = clBtnFace
    292     Font.Height = -11
    293     Font.Name = 'MS Sans Serif'
    294     Font.Style = []
    295     ParentFont = False
    296     TabOrder = 1
    297     TabStop = True
    298     OnClick = btnServiceTreeClick
    299     OnEnter = pnlServiceTreeButtonEnter
    300     OnExit = pnlServiceTreeButtonExit
    301     object btnServiceTree: TSpeedButton
    302       Left = 2
    303       Top = 2
    304       Width = 22
    305       Height = 22
    306       Hint = 'View services/specialties hierarchically'
    307       Glyph.Data = {
    308         26050000424D26050000000000003604000028000000100000000F0000000100
    309         080000000000F000000000000000000000000001000000010000000000000000
    310         80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA
    311         A6000020400000206000002080000020A0000020C0000020E000004000000040
    312         20000040400000406000004080000040A0000040C0000040E000006000000060
    313         20000060400000606000006080000060A0000060C0000060E000008000000080
    314         20000080400000806000008080000080A0000080C0000080E00000A0000000A0
    315         200000A0400000A0600000A0800000A0A00000A0C00000A0E00000C0000000C0
    316         200000C0400000C0600000C0800000C0A00000C0C00000C0E00000E0000000E0
    317         200000E0400000E0600000E0800000E0A00000E0C00000E0E000400000004000
    318         20004000400040006000400080004000A0004000C0004000E000402000004020
    319         20004020400040206000402080004020A0004020C0004020E000404000004040
    320         20004040400040406000404080004040A0004040C0004040E000406000004060
    321         20004060400040606000406080004060A0004060C0004060E000408000004080
    322         20004080400040806000408080004080A0004080C0004080E00040A0000040A0
    323         200040A0400040A0600040A0800040A0A00040A0C00040A0E00040C0000040C0
    324         200040C0400040C0600040C0800040C0A00040C0C00040C0E00040E0000040E0
    325         200040E0400040E0600040E0800040E0A00040E0C00040E0E000800000008000
    326         20008000400080006000800080008000A0008000C0008000E000802000008020
    327         20008020400080206000802080008020A0008020C0008020E000804000008040
    328         20008040400080406000804080008040A0008040C0008040E000806000008060
    329         20008060400080606000806080008060A0008060C0008060E000808000008080
    330         20008080400080806000808080008080A0008080C0008080E00080A0000080A0
    331         200080A0400080A0600080A0800080A0A00080A0C00080A0E00080C0000080C0
    332         200080C0400080C0600080C0800080C0A00080C0C00080C0E00080E0000080E0
    333         200080E0400080E0600080E0800080E0A00080E0C00080E0E000C0000000C000
    334         2000C0004000C0006000C0008000C000A000C000C000C000E000C0200000C020
    335         2000C0204000C0206000C0208000C020A000C020C000C020E000C0400000C040
    336         2000C0404000C0406000C0408000C040A000C040C000C040E000C0600000C060
    337         2000C0604000C0606000C0608000C060A000C060C000C060E000C0800000C080
    338         2000C0804000C0806000C0808000C080A000C080C000C080E000C0A00000C0A0
    339         2000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0E000C0C00000C0C0
    340         2000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0A000808080000000
    341         FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFF0700
    342         07FFFFFFFFFFFFFFFFFFFFA4A407000400FF040404040404FFFFFFA4FFFF0700
    343         07FFFFFFFFFFFFFFFFFFFFA4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA4FFFFFFFF
    344         FFFF070007FFFFFFFFFFFFA4FFFFFFA4A407000400FF04040404FFA4FFFFFFA4
    345         FFFF070007FFFFFFFFFFFFA4FFFFFF07FFFFFFFFFFFFFFFFFFFFFFA4FFFF0700
    346         07FFFFFFFFFFFFFFFFFFFFA4A407000400FF0404040404FFFFFFFFA4FFFF0700
    347         07FFFFFFFFFFFFFFFFFFFF07FFFFFFFFFFFFFFFFFFFFFFFFFFFF070007FFFFFF
    348         FFFFFFFFFFFFFFFFFFFF00FB00FF0404040404FFFFFFFFFFFFFF070007FFFFFF
    349         FFFFFFFFFFFFFFFFFFFF}
    350       Margin = 0
    351       ParentShowHint = False
    352       ShowHint = True
    353       OnClick = btnServiceTreeClick
    354     end
    355   end
    356   object cmdLexSearch: TButton [15]
    357     Left = 543
    358     Top = 94
    359     Width = 49
    360     Height = 21
    361     Anchors = [akTop, akRight]
    362     Caption = 'Lexicon'
    363     TabOrder = 9
    364     OnClick = cmdLexSearchClick
    365   end
    366   object gbInptOpt: TGroupBox [16]
    367     Left = 309
    368     Top = 35
    369     Width = 140
    370     Height = 45
    371     Anchors = [akTop, akRight]
    372     Caption = 'Patient will be seen as an:'
    373     TabOrder = 5
    374     object radInpatient: TRadioButton
    375       Left = 3
    376       Top = 20
    377       Width = 61
    378       Height = 13
    379       Caption = '&Inpatient'
    380       TabOrder = 0
    381       OnClick = radInpatientClick
    382     end
    383     object radOutpatient: TRadioButton
    384       Left = 67
    385       Top = 20
    386       Width = 70
    387       Height = 13
    388       Caption = '&Outpatient'
    389       TabOrder = 1
    390       OnClick = radOutpatientClick
    391     end
    392   end
    393   object btnDiagnosis: TButton [17]
    394     Left = 543
    395     Top = 95
    396     Width = 49
    397     Height = 20
    398     Anchors = [akTop, akRight]
    399     Caption = 'Diagnosis'
    400     TabOrder = 7
    401     OnClick = btnDiagnosisClick
    402   end
    403   inherited cmdAccept: TButton
    404     Left = 439
    405     Top = 315
    406     Anchors = [akLeft, akBottom]
    407     TabOrder = 12
    408     ExplicitLeft = 439
    409     ExplicitTop = 315
     506    ExplicitLeft = 427
     507    ExplicitTop = 394
    410508  end
    411509  inherited cmdQuit: TButton
    412510    Left = 531
    413     Top = 315
     511    Top = 394
    414512    Width = 61
    415513    Anchors = [akLeft, akBottom]
    416     TabOrder = 13
     514    TabOrder = 4
    417515    ExplicitLeft = 531
    418     ExplicitTop = 315
     516    ExplicitTop = 394
    419517    ExplicitWidth = 61
    420518  end
    421519  inherited pnlMessage: TPanel
    422520    Left = 13
    423     Top = 295
     521    Top = 374
    424522    Width = 377
    425523    Anchors = [akLeft, akRight, akBottom]
    426     TabOrder = 14
     524    TabOrder = 5
    427525    ExplicitLeft = 13
    428     ExplicitTop = 295
     526    ExplicitTop = 374
    429527    ExplicitWidth = 377
    430528    inherited memMessage: TRichEdit
    … …  
    436534    Data = (
    437535      (
     536        'Component = memOrder'
     537        'Status = stsDefault')
     538      (
     539        'Component = cmdAccept'
     540        'Status = stsDefault')
     541      (
     542        'Component = cmdQuit'
     543        'Status = stsDefault')
     544      (
     545        'Component = pnlMessage'
     546        'Status = stsDefault')
     547      (
     548        'Component = memMessage'
     549        'Status = stsDefault')
     550      (
     551        'Component = frmODCslt'
     552        'Status = stsDefault')
     553      (
     554        'Component = pnlMain'
     555        'Status = stsDefault')
     556      (
     557        'Component = lblLatest'
     558        'Status = stsDefault')
     559      (
     560        'Component = lblEarliest'
     561        'Status = stsDefault')
     562      (
    438563        'Component = pnlReason'
    439564        'Status = stsDefault')
    440565      (
    441566        'Component = memReason'
    442         'Label = lblReason'
    443         'Status = stsOK')
     567        'Status = stsDefault')
    444568      (
    445569        'Component = cboService'
    … …  
    447571      (
    448572        'Component = cboUrgency'
    449         'Label = lblUrgency'
    450         'Status = stsOK')
     573        'Status = stsDefault')
    451574      (
    452575        'Component = cboPlace'
    453         'Label = lblPlace'
    454         'Status = stsOK')
     576        'Status = stsDefault')
    455577      (
    456578        'Component = txtProvDiag'
    457         'Label = lblProvDiag'
    458         'Status = stsOK')
     579        'Status = stsDefault')
    459580      (
    460581        'Component = txtAttn'
    461         'Label = lblAttn'
    462         'Status = stsOK')
     582        'Status = stsDefault')
    463583      (
    464584        'Component = treService'
    … …  
    471591        'Status = stsDefault')
    472592      (
     593        'Component = gbInptOpt'
     594        'Status = stsDefault')
     595      (
     596        'Component = radInpatient'
     597        'Status = stsDefault')
     598      (
     599        'Component = radOutpatient'
     600        'Status = stsDefault')
     601      (
     602        'Component = btnDiagnosis'
     603        'Status = stsDefault')
     604      (
    473605        'Component = cmdLexSearch'
    474606        'Status = stsDefault')
    475607      (
    476         'Component = gbInptOpt'
    477         'Status = stsDefault')
    478       (
    479         'Component = radInpatient'
    480         'Status = stsDefault')
    481       (
    482         'Component = radOutpatient'
    483         'Status = stsDefault')
    484       (
    485         'Component = btnDiagnosis'
    486         'Status = stsDefault')
    487       (
    488         'Component = memOrder'
    489         'Status = stsDefault')
    490       (
    491         'Component = cmdAccept'
    492         'Status = stsDefault')
    493       (
    494         'Component = cmdQuit'
    495         'Status = stsDefault')
    496       (
    497         'Component = pnlMessage'
    498         'Status = stsDefault')
    499       (
    500         'Component = memMessage'
    501         'Status = stsDefault')
    502       (
    503         'Component = frmODCslt'
     608        'Component = calEarliest'
     609        'Status = stsDefault')
     610      (
     611        'Component = calLatest'
     612        'Status = stsDefault')
     613      (
     614        'Component = pnlCombatVet'
     615        'Status = stsDefault')
     616      (
     617        'Component = txtCombatVet'
     618        'Status = stsDefault')
     619      (
     620        'Component = servicelbl508'
    504621        'Status = stsDefault'))
    505622  end
    506623  object mnuPopProvDx: TPopupMenu
    507     Left = 353
    508     Top = 77
     624    Left = 489
     625    Top = 150
    509626    object mnuPopProvDxDelete: TMenuItem
    510627      Caption = 'Delete diagnosis'
    … …  
    514631  object popReason: TPopupMenu
    515632    OnPopup = popReasonPopup
    516     Left = 411
    517     Top = 188
     633    Left = 547
     634    Top = 316
    518635    object popReasonCut: TMenuItem
    519636      Caption = 'Cu&t'

  • cprs/trunk/CPRS-Chart/Consults/fODConsult.pas

    r829 r1679  
    99  fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
    1010  Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet,
    11   VA508AccessibilityManager ;
     11  ORDtTm, VA508AccessibilityManager ;
    1212
    1313type
    1414  TfrmODCslt = class(TfrmODBase)
     15    pnlMain: TPanel;
     16    lblService: TLabel;
     17    lblProvDiag: TLabel;
     18    lblUrgency: TLabel;
     19    lblPlace: TLabel;
     20    lblAttn: TLabel;
     21    lblLatest: TStaticText;
     22    lblEarliest: TStaticText;
     23    pnlReason: TPanel;
     24    lblReason: TLabel;
     25    memReason: TRichEdit;
    1526    cboService: TORComboBox;
    1627    cboUrgency: TORComboBox;
    … …  
    1829    txtProvDiag: TCaptionEdit;
    1930    txtAttn: TORComboBox;
    20     lblService: TLabel;
    21     lblUrgency: TLabel;
    22     lblPlace: TLabel;
    23     lblAttn: TLabel;
    24     lblProvDiag: TLabel;
    2531    treService: TORTreeView;
    2632    cboCategory: TORComboBox;
    2733    pnlServiceTreeButton: TKeyClickPanel;
    2834    btnServiceTree: TSpeedButton;
     35    gbInptOpt: TGroupBox;
     36    radInpatient: TRadioButton;
     37    radOutpatient: TRadioButton;
     38    btnDiagnosis: TButton;
     39    cmdLexSearch: TButton;
     40    calEarliest: TORDateBox;
     41    calLatest: TORDateBox;
    2942    mnuPopProvDx: TPopupMenu;
    3043    mnuPopProvDxDelete: TMenuItem;
    31     cmdLexSearch: TButton;
    3244    popReason: TPopupMenu;
    3345    popReasonCut: TMenuItem;
    … …  
    3648    popReasonPaste2: TMenuItem;
    3749    popReasonReformat: TMenuItem;
    38     gbInptOpt: TGroupBox;
    39     radInpatient: TRadioButton;
    40     radOutpatient: TRadioButton;
    41     pnlReason: TPanel;
    42     lblReason: TLabel;
    43     memReason: TRichEdit;
    44     btnDiagnosis: TButton;
     50    pnlCombatVet: TPanel;
     51    txtCombatVet: TVA508StaticText;
     52    servicelbl508: TVA508StaticText;
    4553    procedure FormCreate(Sender: TObject);
    4654    procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
    … …  
    96104    FEditCtrl: TCustomEdit;
    97105    FNavigatingTab: boolean;
     106    LLS_LINE_INDEX: integer;
    98107    procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode);
    99108    procedure ReadServerVariables;
    … …  
    107116    procedure SetUpCopyConsultDiagnoses(pOrderID:string);
    108117    procedure AdjustMemReasonSize;
     118    function NotinIndex(AList: TStringList; i: integer): boolean;
     119    function GetItemIndex(Service: String; Index: integer): integer;
     120    procedure SetUpCombatVet;
     121    procedure SetUpEarliestDate; //wat v28
     122    procedure setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox);
    109123  protected
    110124    procedure InitDialog; override;
    … …  
    123137
    124138
     139function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
     140
    125141implementation
    126142
    … …  
    129145uses
    130146    rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq,
    131     ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility;
     147    ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility,
     148    VA508AccessibilityRouter;
    132149
    133150var
    … …  
    137154  BADxUpdated: boolean;
    138155  quickCode: string;
    139 
     156  AreGlobalsFree: boolean;
    140157
    141158
    … …  
    156173  TX_INACTIVE_CODE_REQD     = 'Another code must be selected before the order can be saved.';
    157174  TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
     175  TX_PAST_DATE       = 'Earliest appropriate date must be today or later.';
     176  TX_BAD_DATES       = 'Latest appropriate date must be equal to or later than earliest date.';
    158177
    159178  TX_SVC_HRCHY = 'services/specialties hierarchy';
    160179  TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically';
    161180  TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view';
     181
     182
     183{************** Static Unit Methods ***************}
     184
     185function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
     186begin
     187  Result := true;
     188  if (dialog is TfrmODCslt) then
     189    Result := AreGlobalsFree;
     190end;
     191
     192procedure InitializeGlobalLists;
     193begin
     194  Defaults := TStringList.Create;
     195  SvcList := TStringList.Create;
     196  QuickList := TStringList.Create;
     197  AreGlobalsFree := false;
     198end;
     199
     200function FreeGlobalLists : Boolean;
     201begin
     202  Result := false;
     203  if AreGlobalsFree then
     204    Exit;
     205  Defaults.Free;
     206  SvcList.Free;
     207  QuickList.Free;
     208  AreGlobalsFree := true;
     209  Result := true;
     210end;
     211
     212{*************** TfrmODCslt Methods ***********}
    162213
    163214procedure TfrmODCslt.FormCreate(Sender: TObject);
    … …  
    176227     cmdLexSearch.Visible := True;
    177228  end;
    178   Defaults  := TStringList.Create ;
    179   SvcList   := TStringList.Create ;
    180   QuickList := TStringList.Create ;
     229  InitializeGlobalLists;
    181230  AllowQuickOrder := True;
    182231  LastNode := 0;
    … …  
    190239  FastAssign(ODForConsults, Defaults);  // ODForConsults returns TStrings with defaults
    191240  CtrlInits.LoadDefaults(Defaults);
     241  calEarliest.Text := 'TODAY';
     242  //calLatest.Text := 'TODAY+30';
    192243  txtAttn.InitLongList('') ;
    193244  PreserveControl(txtAttn);
     245  PreserveControl(calEarliest);
     246  //PreserveControl(calLatest);
     247    if (patient.CombatVet.IsEligible = True) then
     248   begin
     249     SetUpCombatVet;
     250   end
     251   else
     252    begin
     253      txtCombatVet.Enabled := False;
     254      pnlCombatVet.SendToBack;
     255    end;
    194256  InitDialog;
    195257  //Calling virtual SetFontSize in constructor is a bad idea!
    … …  
    197259  FcboServiceKeyDownStopClick := false;
    198260  consultQuickOrder := false;
    199 
    200 
    201261end;
    202262
    … …  
    233293  memReason.Clear;
    234294  cboService.Enabled := True;
     295  setup508Label(servicelbl508, cboService);
    235296  cboService.Font.Color := clWindowText;
    236   cboService.Height := 25 + (7 * cboService.ItemHeight);
     297  cboService.Height := 25 + (11 * cboService.ItemHeight);
    237298  btnServiceTree.Enabled := True;
    238299  pnlServiceTreeButton.Enabled := True;
    239300  SetProvDiagPromptingMode;
    240   ActiveControl := cboService; // set after call to SetProvDiagPromptingMode
     301  ActiveControl := cboService;
     302
    241303  Changing := False;
    242304  StatusText('');
    … …  
    258320begin
    259321  inherited;
     322  LLS_LINE_INDEX := -1;
    260323  ReadServerVariables;
    261324  AList := TStringList.Create;
    … …  
    281344          Exit;
    282345        end;
     346
    283347      cboService.Items.Add(SvcIEN + U + tmpResp.EValue + '^^^^' + tmpResp.IValue);
    284348      cboService.SelectByID(SvcIEN);
    … …  
    289353      else
    290354        radOutpatient.Checked := True ;
    291       SetControl(cboUrgency,    'URGENCY',     1);
     355      SetUpEarliestDate;   //wat v28
     356      SetControl(cboUrgency,    'URGENCY',   1);
    292357      SetControl(cboPlace,      'PLACE',     1);
    293358      SetControl(txtAttn,       'PROVIDER',  1);
     359      SetControl(calEarliest,   'EARLIEST',  1);
     360      //SetControl(calLatest,     'LATEST',    1);
    294361      cboService.Enabled := False;
     362      setup508Label(servicelbl508, cboService);
    295363      cboService.Font.Color := clGrayText;
    296364      btnServiceTree.Enabled := False;
    … …  
    308376      begin
    309377        AbortOrder := True;
     378                SetTemplateDialogCanceled(FALSE);
    310379        Close;
    311380        Exit;
    … …  
    316385      begin
    317386        AbortOrder := True;
     387                SetTemplateDialogCanceled(FALSE);
    318388        Close;
    319389        Exit;
    … …  
    343413          FastAssign(QuickList, cboService.Items);
    344414          Items.Add(LLS_LINE);
     415          LLS_LINE_INDEX := Items.IndexOf(Trim(Piece(LLS_LINE, U, 2))); {TP - HDS00015782: Used to determine if QO}
    345416          Items.Add(LLS_SPACE);
    346417        end;
    347418      Changing := True;
    348419      for i := 0 to AList.Count - 1 do
    349         if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and   {RV}
     420        //if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and   {RV}
     421        if (NotinIndex(AList,i)) and   {TP - HDS00015782: Check if service is already in index (not including QO)}
    350422        //if (cboService.SelectByID(Piece(AList.Strings[i], U, 1)) = -1) and
    351423           (Piece(AList.Strings[i], U, 5) <> '1') then
    … …  
    410482        SetError(TX_SELECT_DIAG);
    411483    end;
     484  if (lblEarliest.Enabled) and (calEarliest.FMDateTime < FMToday) then SetError(TX_PAST_DATE);
     485  //if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE);
     486  //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
    412487end;
    413488
    … …  
    548623        FLastServiceID := ItemID;
    549624        cboService.Enabled := False;
     625        setup508Label(servicelbl508, cboService);
    550626        cboService.Font.Color := clGrayText;
    551627        btnServiceTree.Enabled := False;
    … …  
    588664      SetControl(cboPlace,      'PLACE',     1);
    589665      SetControl(txtAttn,       'PROVIDER',  1);
     666      SetControl(calEarliest,   'EARLIEST',  1);
     667      //SetControl(calLatest,     'LATEST',    1);
    590668      SetTemplateDialogCanceled(FALSE);
    591669      SetControl(memReason,     'COMMENT',   1);
    … …  
    593671      begin
    594672        AbortOrder := TRUE;
     673                SetTemplateDialogCanceled(FALSE);
    595674        Close;
    596675        Exit;
    … …  
    616695    end;
    617696  SetProvDiagPromptingMode;
     697  SetUpEarliestDate; //wat v28
    618698  tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6);
    619699  pnlMessage.TabOrder := treService.TabOrder + 1;
    … …  
    646726      else Responses.Update('ORDERABLE', 1, '', '');
    647727    end;
    648   with memReason     do if GetTextLen   > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
    649   with cboCategory   do if ItemID     <> '' then Responses.Update('CLASS',     1, ItemID, Text);
    650   with cboUrgency    do if ItemIEN      > 0 then Responses.Update('URGENCY',   1, ItemID, Text);
    651   with cboPlace      do if ItemID     <> '' then Responses.Update('PLACE',     1, ItemID, Text);
    652   with txtAttn       do if ItemIEN      > 0 then Responses.Update('PROVIDER',  1, ItemID, Text);
     728  with memReason     do  Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
     729  with cboCategory   do  Responses.Update('CLASS',     1, ItemID, Text);
     730  with cboUrgency    do  Responses.Update('URGENCY',   1, ItemID, Text);
     731  with cboPlace      do  Responses.Update('PLACE',     1, ItemID, Text);
     732  with txtAttn       do  Responses.Update('PROVIDER',  1, ItemID, Text);
     733  with calEarliest   do if Length(Text) > 0 then Responses.Update('EARLIEST',  1, Text,   Text);
     734  //with calLatest     do if Length(Text) > 0 then Responses.Update('LATEST',    1, Text,   Text);
    653735  //with txtProvDiag   do if Length(Text) > 0 then Responses.Update('MISC',      1, Text,   Text);
    654736  if Length(ProvDx.Text)                > 0 then Responses.Update('MISC',      1, ProvDx.Text,   ProvDx.Text)
    … …  
    758840  with cboService do
    759841    begin
     842      setup508Label(servicelbl508, cboService);
    760843      if (ItemIndex < 0) or (ItemID = '') then
    761844        begin
    … …  
    779862          Changing := True;
    780863          Responses.QuickOrder := ExtractInteger(ItemID);
    781           consultQuickOrder := True;   
     864          consultQuickOrder := True;
    782865          tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).EValue;
    783866          ItemIndex := Items.IndexOf(Trim(tmpSvc));
     867          If ItemIndex < LLS_LINE_INDEX then       {TP - HDS00015782: Check if index is of a QO}
     868            ItemIndex := GetItemIndex(tmpSvc,ItemIndex);
    784869(*          tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
    785870          for i := 0 to Items.Count-1 do
    … …  
    793878          FLastServiceID := ItemID;
    794879          Enabled := False;
     880          setup508Label(servicelbl508, cboService);
    795881          Font.Color := clGrayText;
    796882          btnServiceTree.Enabled := False;
    … …  
    811897              SetControl(cboPlace,      'PLACE',     1);
    812898              SetControl(txtAttn,       'PROVIDER',  1);
     899              SetControl(calEarliest,   'EARLIEST',  1);
     900              //SetControl(calLatest,     'LATEST',    1);
    813901              SetTemplateDialogCanceled(FALSE);
    814902              SetControl(memReason,     'COMMENT',   1);
    … …  
    816904              begin
    817905                AbortOrder := TRUE;
     906                                SetTemplateDialogCanceled(FALSE);
    818907                Close;
    819908                Exit;
    … …  
    861950  //OrderMessage(ConsultMessage(cboService.ItemIEN));
    862951  ControlChange(Self) ;
     952  SetUpEarliestDate;    //wat v28
     953  setup508Label(servicelbl508, cboService);
    863954end;
    864955
    865956procedure TfrmODCslt.FormDestroy(Sender: TObject);
    866957begin
    867   Defaults.Free;
    868   SvcList.Free ;
    869   QuickList.Free;
     958  if not FreeGlobalLists then
     959    Exit;
    870960  inherited;
    871961end;
    … …  
    9861076 ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
    9871077 txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
    988 
    9891078 ProvDx.CodeInactive := False;
    9901079end;
    … …  
    10571146
    10581147
     1148procedure TfrmODCslt.setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox);
     1149begin
     1150  if ScreenReaderSystemActive and not ctrl.Enabled then begin
     1151    lbl.Enabled := True;
     1152    lbl.Visible := True;
     1153    lbl.Caption := lblService.Caption + ', ' + ctrl.Text;
     1154    lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left;
     1155  end else
     1156    lbl.Visible := false;
     1157end;
     1158
    10591159procedure TfrmODCslt.mnuPopProvDxDeleteClick(Sender: TObject);
    10601160begin
    … …  
    14931593  pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE;
    14941594  pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE;
     1595  if patient.CombatVet.IsEligible then pnlReason.Height := pnlReason.Height - PIXEL_SPACE*20;
     1596end;
     1597
     1598function TfrmODCslt.NotinIndex(AList: TStringList; i: integer): Boolean;   {TP - HDS00015782:}
     1599{This function determines if a Consult Service will be added to the cboService
     1600component.  If name does not exist or if name does not exist below the Quick
     1601Order listing, then it is added.}
     1602var
     1603  x: Integer;
     1604  y: String;
     1605begin
     1606  Result := False;
     1607  x := cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2)));
     1608  if (x = -1) then
     1609    Result := True;
     1610  if (x <> -1) and (x < LLS_LINE_INDEX) then
     1611  begin
     1612    y := cboService.Items[x];
     1613    cboService.Items.Delete(x);
     1614    if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) then
     1615      Result := True;
     1616    cboService.Items.Insert(x,y);
     1617  end;
     1618
     1619end;
     1620
     1621function TfrmODCslt.GetItemIndex(Service: String; Index: integer): integer;     {TP - HDS00015782:}
     1622{This function returns ItemIndexOf value for Service Consult when a Quick Order
     1623has the exact same name}
     1624var
     1625  y: String;
     1626
     1627begin
     1628  y := cboService.Items[Index];
     1629  cboService.Items.Delete(Index);
     1630  Result := (cboService.Items.IndexOf(Trim(Service)) + 1);
     1631  cboService.Items.Insert(Index,y);
     1632end;
     1633
     1634procedure TfrmODCslt.SetUpCombatVet;
     1635begin
     1636     pnlCombatVet.BringToFront;
     1637     txtCombatVet.Enabled := True;
     1638     txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
     1639     pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
     1640     pnlMain.Anchors := [akLeft,akTop,akRight];
     1641     treService.Anchors := [akLeft,akTop,akRight];
     1642     self.Height := self.Height + pnlCombatVet.Height;
     1643     treService.Anchors := [akLeft,akTop,akRight,akBottom];
     1644     pnlMain.Anchors := [akLeft,akTop,akRight,akBottom];
     1645end;
     1646
     1647procedure TfrmODCslt.SetUpEarliestDate;  //wat v28
     1648begin
     1649  if IsProstheticsService(cboService.ItemIEN) = '1' then
     1650    begin
     1651      lblEarliest.Enabled := False;
     1652      calEarliest.Enabled := False;
     1653      calEarliest.Text := '';
     1654      Responses.Update('EARLIEST',1,'','');
     1655    end
     1656  else
     1657    begin
     1658      lblEarliest.Enabled := True;
     1659      calEarliest.Enabled := True;
     1660      calEarliest.Text := 'TODAY';
     1661    end;
    14951662end;
    14961663

  • cprs/trunk/CPRS-Chart/Consults/fODProc.dfm

    r829 r1679  
    11inherited frmODProc: TfrmODProc
    22  Tag = 112
    3   Left = 208
    4   Top = 188
    5   Width = 543
    6   Height = 393
     3  Left = 430
     4  Top = 203
     5  Width = 606
     6  Height = 442
    77  HorzScrollBar.Range = 523
    88  VertScrollBar.Range = 295
     9  Anchors = [akLeft, akTop, akRight, akBottom]
    910  Caption = 'Order a Procedure'
    10   Constraints.MinHeight = 393
    11   Constraints.MinWidth = 543
    12   ExplicitLeft = 208
    13   ExplicitTop = 188
    14   ExplicitWidth = 543
    15   ExplicitHeight = 393
     11  Constraints.MinHeight = 442
     12  Constraints.MinWidth = 606
     13  Position = poDesigned
     14  OnShow = FormShow
     15  ExplicitWidth = 606
     16  ExplicitHeight = 442
    1617  PixelsPerInch = 96
    1718  TextHeight = 13
    18   object lblProc: TLabel [0]
    19     Left = 4
    20     Top = 4
    21     Width = 49
    22     Height = 13
    23     Caption = 'Procedure'
    24   end
    25   object lblService: TOROffsetLabel [1]
    26     Left = 4
    27     Top = 42
    28     Width = 158
    29     Height = 15
    30     Caption = 'Service to perform this procedure'
    31     HorzOffset = 2
    32     Transparent = False
    33     VertOffset = 2
    34     WordWrap = False
    35   end
    36   object lblReason: TLabel [2]
    37     Left = 4
    38     Top = 103
    39     Width = 95
    40     Height = 13
    41     Caption = 'Reason for Request'
    42   end
    43   object lblUrgency: TStaticText [3]
    44     Left = 249
    45     Top = 4
    46     Width = 44
    47     Height = 17
    48     Anchors = [akTop, akRight]
    49     Caption = 'Urgency'
    50     TabOrder = 15
    51   end
    52   object lblPlace: TStaticText [4]
    53     Left = 396
    54     Top = 43
    55     Width = 104
    56     Height = 17
    57     Anchors = [akTop, akRight]
    58     Caption = 'Place of Consultation'
    59     TabOrder = 16
    60   end
    61   object lblAttn: TStaticText [5]
    62     Left = 396
    63     Top = 4
    64     Width = 46
    65     Height = 17
    66     Anchors = [akTop, akRight]
    67     Caption = 'Attention'
    68     TabOrder = 17
    69   end
    70   object lblProvDiag: TStaticText [6]
    71     Left = 249
    72     Top = 81
    73     Width = 104
    74     Height = 17
    75     Anchors = [akTop, akRight]
    76     Caption = 'Provisional Diagnosis'
    77     TabOrder = 18
    78   end
    79   object pnlReason: TPanel [7]
     19  object pnlCombatVet: TPanel [0]
    8020    Left = 0
    81     Top = 120
    82     Width = 528
    83     Height = 192
    84     Anchors = [akLeft, akTop, akRight, akBottom]
    85     BevelOuter = bvNone
    86     TabOrder = 9
    87     object memReason: TCaptionRichEdit
    88       Left = 0
    89       Top = 0
    90       Width = 528
    91       Height = 192
     21    Top = 0
     22    Width = 598
     23    Height = 25
     24    Align = alTop
     25    BevelOuter = bvLowered
     26    Font.Charset = DEFAULT_CHARSET
     27    Font.Color = clWindowText
     28    Font.Height = -11
     29    Font.Name = 'MS Sans Serif'
     30    Font.Style = []
     31    ParentFont = False
     32    TabOrder = 0
     33    object txtCombatVet: TVA508StaticText
     34      Name = 'txtCombatVet'
     35      Left = 1
     36      Top = 1
     37      Width = 596
     38      Height = 23
    9239      Align = alClient
    93       Font.Charset = DEFAULT_CHARSET
    94       Font.Color = clWindowText
    95       Font.Height = -11
    96       Font.Name = 'Courier New'
    97       Font.Style = []
    98       Constraints.MinHeight = 40
    99       ParentFont = False
    100       PopupMenu = popReason
    101       ScrollBars = ssBoth
     40      Alignment = taCenter
     41      BevelOuter = bvNone
     42      Enabled = False
    10243      TabOrder = 0
    103       WantTabs = True
    104       OnChange = ControlChange
    105       OnExit = memReasonExit
    106       OnKeyDown = memReasonKeyDown
    107       OnKeyPress = memReasonKeyPress
    108       OnKeyUp = memReasonKeyUp
    109       Caption = 'Reason for Request'
     44      ShowAccelChar = True
    11045    end
    11146  end
    11247  inherited memOrder: TCaptionMemo
    11348    Left = 0
    114     Top = 321
     49    Top = 365
    11550    Width = 380
    11651    Height = 41
    117     Anchors = [akLeft, akRight]
     52    Anchors = [akLeft, akRight, akBottom]
    11853    Lines.Strings = (
    11954      'The order text...'
    … …  
    12257        '--------------'
    12358      'An order message may be displayed here.')
    124     TabOrder = 1
     59    ParentFont = False
     60    TabOrder = 3
    12561    ExplicitLeft = 0
    126     ExplicitTop = 321
     62    ExplicitTop = 365
    12763    ExplicitWidth = 380
    12864    ExplicitHeight = 41
    12965  end
    130   object cboUrgency: TORComboBox [9]
    131     Left = 249
    132     Top = 17
    133     Width = 133
    134     Height = 21
    135     Anchors = [akTop, akRight]
    136     Style = orcsDropDown
    137     AutoSelect = True
    138     Caption = 'Urgency'
    139     Color = clWindow
    140     DropDownCount = 8
    141     ItemHeight = 13
    142     ItemTipColor = clWindow
    143     ItemTipEnable = True
    144     ListItemsOnly = True
    145     LongList = False
    146     LookupPiece = 0
    147     MaxLength = 0
    148     Pieces = '2'
    149     Sorted = False
    150     SynonymChars = '<>'
    151     TabOrder = 2
    152     OnChange = ControlChange
    153     CharsNeedMatch = 1
    154   end
    155   object cboPlace: TORComboBox [10]
    156     Left = 396
    157     Top = 56
    158     Width = 133
    159     Height = 21
    160     Anchors = [akTop, akRight]
    161     Style = orcsDropDown
    162     AutoSelect = True
    163     Caption = 'Place of Consultation'
    164     Color = clWindow
    165     DropDownCount = 8
    166     ItemHeight = 13
    167     ItemTipColor = clWindow
    168     ItemTipEnable = True
    169     ListItemsOnly = True
    170     LongList = False
    171     LookupPiece = 0
    172     MaxLength = 0
    173     Pieces = '2'
    174     Sorted = False
    175     SynonymChars = '<>'
    176     TabOrder = 6
    177     OnChange = ControlChange
    178     CharsNeedMatch = 1
    179   end
    180   object txtAttn: TORComboBox [11]
    181     Left = 396
    182     Top = 17
    183     Width = 133
    184     Height = 21
    185     Anchors = [akTop, akRight]
    186     Style = orcsDropDown
    187     AutoSelect = True
    188     Caption = 'Attention'
    189     Color = clWindow
    190     DropDownCount = 8
    191     ItemHeight = 13
    192     ItemTipColor = clWindow
    193     ItemTipEnable = True
    194     ListItemsOnly = True
    195     LongList = True
    196     LookupPiece = 2
    197     MaxLength = 0
    198     Pieces = '2,3'
    199     Sorted = False
    200     SynonymChars = '<>'
    201     TabOrder = 3
    202     OnChange = ControlChange
    203     OnNeedData = txtAttnNeedData
    204     CharsNeedMatch = 1
    205   end
    206   object cboProc: TORComboBox [12]
    207     Left = 4
    208     Top = 17
    209     Width = 227
    210     Height = 21
    211     Anchors = [akLeft, akTop, akRight]
    212     Style = orcsDropDown
    213     AutoSelect = True
    214     Caption = 'Procedure'
    215     Color = clWindow
    216     DropDownCount = 8
    217     ItemHeight = 13
    218     ItemTipColor = clWindow
    219     ItemTipEnable = True
    220     ListItemsOnly = True
    221     LongList = True
    222     LookupPiece = 0
    223     MaxLength = 0
    224     Pieces = '2'
    225     Sorted = False
    226     SynonymChars = '<>'
    227     TabOrder = 0
    228     OnChange = cboProcSelect
    229     OnNeedData = cboProcNeedData
    230     CharsNeedMatch = 1
    231   end
    232   object cboCategory: TORComboBox [13]
    233     Left = 516
    234     Top = 10
    235     Width = 3
    236     Height = 21
    237     Style = orcsDropDown
    238     AutoSelect = True
    239     Color = clWindow
    240     DropDownCount = 8
    241     ItemHeight = 13
    242     ItemTipColor = clWindow
    243     ItemTipEnable = True
    244     ListItemsOnly = False
    245     LongList = False
    246     LookupPiece = 0
    247     MaxLength = 0
    248     Sorted = False
    249     SynonymChars = '<>'
    250     TabOrder = 13
    251     Visible = False
    252     OnChange = ControlChange
    253     CharsNeedMatch = 1
    254   end
    255   object cboService: TORComboBox [14]
    256     Left = 4
    257     Top = 58
    258     Width = 227
    259     Height = 21
    260     Anchors = [akLeft, akTop, akRight]
    261     Style = orcsDropDown
    262     AutoSelect = True
    263     Caption = 'Service to perform this procedure'
    264     Color = clWindow
    265     DropDownCount = 8
    266     Enabled = False
    267     ItemHeight = 13
    268     ItemTipColor = clWindow
    269     ItemTipEnable = True
    270     ListItemsOnly = False
    271     LongList = False
    272     LookupPiece = 0
    273     MaxLength = 0
    274     Pieces = '2'
    275     Sorted = False
    276     SynonymChars = '<>'
     66  object pnlMain: TPanel [2]
     67    Left = 0
     68    Top = 0
     69    Width = 598
     70    Height = 354
     71    Anchors = [akLeft, akTop, akRight, akBottom]
     72    BevelOuter = bvNone
     73    TabOrder = 1
     74    DesignSize = (
     75      598
     76      354)
     77    object lblProc: TLabel
     78      Left = 4
     79      Top = 4
     80      Width = 49
     81      Height = 13
     82      Caption = 'Procedure'
     83    end
     84    object lblService: TOROffsetLabel
     85      Left = 4
     86      Top = 114
     87      Width = 158
     88      Height = 15
     89      Caption = 'Service to perform this procedure'
     90      HorzOffset = 2
     91      Transparent = False
     92      VertOffset = 2
     93      WordWrap = False
     94    end
     95    object lblReason: TLabel
     96      Left = 8
     97      Top = 165
     98      Width = 95
     99      Height = 13
     100      Margins.Left = 0
     101      Caption = 'Reason for Request'
     102    end
     103    object lblUrgency: TStaticText
     104      Left = 312
     105      Top = 4
     106      Width = 44
     107      Height = 17
     108      Anchors = [akTop, akRight]
     109      Caption = 'Urgency'
     110      TabOrder = 13
     111    end
     112    object lblPlace: TStaticText
     113      Left = 460
     114      Top = 92
     115      Width = 104
     116      Height = 17
     117      Anchors = [akTop, akRight]
     118      Caption = 'Place of Consultation'
     119      TabOrder = 14
     120    end
     121    object lblAttn: TStaticText
     122      Left = 460
     123      Top = 4
     124      Width = 46
     125      Height = 17
     126      Anchors = [akTop, akRight]
     127      Caption = 'Attention'
     128      TabOrder = 15
     129    end
     130    object lblProvDiag: TStaticText
     131      Left = 312
     132      Top = 135
     133      Width = 104
     134      Height = 17
     135      Anchors = [akTop, akRight]
     136      Caption = 'Provisional Diagnosis'
     137      TabOrder = 16
     138    end
     139    object pnlReason: TPanel
     140      Left = 0
     141      Top = 184
     142      Width = 591
     143      Height = 166
     144      Anchors = [akLeft, akTop, akRight, akBottom]
     145      BevelOuter = bvNone
     146      TabOrder = 11
     147      object memReason: TCaptionRichEdit
     148        Left = 0
     149        Top = 0
     150        Width = 591
     151        Height = 166
     152        Align = alClient
     153        Anchors = [akLeft, akTop, akRight]
     154        Font.Charset = DEFAULT_CHARSET
     155        Font.Color = clWindowText
     156        Font.Height = -11
     157        Font.Name = 'Courier New'
     158        Font.Style = []
     159        Constraints.MinHeight = 40
     160        ParentFont = False
     161        PopupMenu = popReason
     162        ScrollBars = ssBoth
     163        TabOrder = 0
     164        WantTabs = True
     165        OnChange = ControlChange
     166        OnExit = memReasonExit
     167        OnKeyDown = memReasonKeyDown
     168        OnKeyPress = memReasonKeyPress
     169        OnKeyUp = memReasonKeyUp
     170        Caption = 'Reason for Request'
     171      end
     172    end
     173    object cboUrgency: TORComboBox
     174      Left = 312
     175      Top = 17
     176      Width = 133
     177      Height = 21
     178      Anchors = [akTop, akRight]
     179      Style = orcsDropDown
     180      AutoSelect = True
     181      Caption = 'Urgency'
     182      Color = clWindow
     183      DropDownCount = 8
     184      ItemHeight = 13
     185      ItemTipColor = clWindow
     186      ItemTipEnable = True
     187      ListItemsOnly = True
     188      LongList = False
     189      LookupPiece = 0
     190      MaxLength = 0
     191      Pieces = '2'
     192      Sorted = False
     193      SynonymChars = '<>'
     194      TabOrder = 3
     195      OnChange = ControlChange
     196      CharsNeedMatch = 1
     197    end
     198    object cboPlace: TORComboBox
     199      Left = 460
     200      Top = 105
     201      Width = 133
     202      Height = 21
     203      Anchors = [akTop, akRight]
     204      Style = orcsDropDown
     205      AutoSelect = True
     206      Caption = 'Place of Consultation'
     207      Color = clWindow
     208      DropDownCount = 8
     209      ItemHeight = 13
     210      ItemTipColor = clWindow
     211      ItemTipEnable = True
     212      ListItemsOnly = True
     213      LongList = False
     214      LookupPiece = 0
     215      MaxLength = 0
     216      Pieces = '2'
     217      Sorted = False
     218      SynonymChars = '<>'
     219      TabOrder = 8
     220      OnChange = ControlChange
     221      CharsNeedMatch = 1
     222    end
     223    object txtAttn: TORComboBox
     224      Left = 460
     225      Top = 17
     226      Width = 131
     227      Height = 21
     228      Anchors = [akTop, akRight]
     229      Style = orcsDropDown
     230      AutoSelect = True
     231      Caption = 'Attention'
     232      Color = clWindow
     233      DropDownCount = 8
     234      ItemHeight = 13
     235      ItemTipColor = clWindow
     236      ItemTipEnable = True
     237      ListItemsOnly = True
     238      LongList = True
     239      LookupPiece = 2
     240      MaxLength = 0
     241      Pieces = '2,3'
     242      Sorted = False
     243      SynonymChars = '<>'
     244      TabOrder = 4
     245      OnChange = ControlChange
     246      OnNeedData = txtAttnNeedData
     247      CharsNeedMatch = 1
     248    end
     249    object cboProc: TORComboBox
     250      Left = 4
     251      Top = 17
     252      Width = 290
     253      Height = 91
     254      Anchors = [akLeft, akTop, akRight]
     255      Style = orcsSimple
     256      AutoSelect = True
     257      Caption = 'Procedure'
     258      Color = clWindow
     259      DropDownCount = 8
     260      ItemHeight = 13
     261      ItemTipColor = clWindow
     262      ItemTipEnable = True
     263      ListItemsOnly = True
     264      LongList = True
     265      LookupPiece = 0
     266      MaxLength = 0
     267      Pieces = '2'
     268      Sorted = False
     269      SynonymChars = '<>'
     270      TabOrder = 0
     271      OnChange = cboProcSelect
     272      OnNeedData = cboProcNeedData
     273      CharsNeedMatch = 1
     274    end
     275    object cboCategory: TORComboBox
     276      Left = 516
     277      Top = 10
     278      Width = 3
     279      Height = 21
     280      Style = orcsDropDown
     281      AutoSelect = True
     282      Color = clWindow
     283      DropDownCount = 8
     284      ItemHeight = 13
     285      ItemTipColor = clWindow
     286      ItemTipEnable = True
     287      ListItemsOnly = False
     288      LongList = False
     289      LookupPiece = 0
     290      MaxLength = 0
     291      Sorted = False
     292      SynonymChars = '<>'
     293      TabOrder = 12
     294      Visible = False
     295      OnChange = ControlChange
     296      CharsNeedMatch = 1
     297    end
     298    object cboService: TORComboBox
     299      Left = 4
     300      Top = 130
     301      Width = 290
     302      Height = 21
     303      Anchors = [akLeft, akTop, akRight]
     304      Style = orcsDropDown
     305      AutoSelect = True
     306      Caption = 'Service to perform this procedure'
     307      Color = clWindow
     308      DropDownCount = 8
     309      Enabled = False
     310      ItemHeight = 13
     311      ItemTipColor = clWindow
     312      ItemTipEnable = True
     313      ListItemsOnly = False
     314      LongList = False
     315      LookupPiece = 0
     316      MaxLength = 0
     317      Pieces = '2'
     318      Sorted = False
     319      SynonymChars = '<>'
     320      TabOrder = 1
     321      OnChange = cboServiceChange
     322      CharsNeedMatch = 1
     323    end
     324    object cmdLexSearch: TButton
     325      Left = 549
     326      Top = 149
     327      Width = 49
     328      Height = 21
     329      Anchors = [akTop, akRight]
     330      Caption = 'Lexicon'
     331      TabOrder = 10
     332      OnClick = cmdLexSearchClick
     333    end
     334    object gbInptOpt: TGroupBox
     335      Left = 312
     336      Top = 85
     337      Width = 140
     338      Height = 45
     339      Anchors = [akTop, akRight]
     340      Caption = 'Patient will be seen as an:'
     341      TabOrder = 7
     342      object radInpatient: TRadioButton
     343        Left = 3
     344        Top = 20
     345        Width = 61
     346        Height = 17
     347        Caption = '&Inpatient'
     348        TabOrder = 1
     349        OnClick = radInpatientClick
     350      end
     351      object radOutpatient: TRadioButton
     352        Left = 67
     353        Top = 20
     354        Width = 71
     355        Height = 17
     356        Caption = '&Outpatient'
     357        TabOrder = 0
     358        OnClick = radOutpatientClick
     359      end
     360    end
     361    object txtProvDiag: TCaptionEdit
     362      Left = 312
     363      Top = 149
     364      Width = 234
     365      Height = 21
     366      Anchors = [akTop, akRight]
     367      MaxLength = 180
     368      ParentShowHint = False
     369      PopupMenu = mnuPopProvDx
     370      ShowHint = True
     371      TabOrder = 9
     372      OnChange = txtProvDiagChange
     373      Caption = 'Provisional Diagnosis'
     374    end
     375    object lblEarliest: TStaticText
     376      Left = 312
     377      Top = 44
     378      Width = 121
     379      Height = 17
     380      Anchors = [akTop, akRight]
     381      Caption = 'Earliest appropriate date:'
     382      TabOrder = 18
     383    end
     384    object calEarliest: TORDateBox
     385      Left = 312
     386      Top = 58
     387      Width = 133
     388      Height = 21
     389      Anchors = [akTop, akRight]
     390      TabOrder = 5
     391      OnChange = ControlChange
     392      DateOnly = True
     393      RequireTime = False
     394    end
     395    object lblLatest: TStaticText
     396      Left = 460
     397      Top = 44
     398      Width = 116
     399      Height = 17
     400      Anchors = [akTop, akRight]
     401      Caption = 'Latest appropriate date:'
     402      TabOrder = 19
     403      Visible = False
     404    end
     405    object calLatest: TORDateBox
     406      Left = 460
     407      Top = 58
     408      Width = 131
     409      Height = 21
     410      Anchors = [akTop, akRight]
     411      TabOrder = 6
     412      Visible = False
     413      OnChange = ControlChange
     414      DateOnly = True
     415      RequireTime = False
     416    end
     417    object servicelbl508: TVA508StaticText
     418      Name = 'servicelbl508'
     419      Left = 183
     420      Top = 114
     421      Width = 106
     422      Height = 15
     423      Alignment = taLeftJustify
     424      Caption = 'service (for screen R.)'
     425      Enabled = False
     426      TabOrder = 2
     427      Visible = False
     428      ShowAccelChar = True
     429    end
     430  end
     431  inherited cmdAccept: TButton
     432    Left = 427
     433    Top = 382
     434    Anchors = [akRight, akBottom]
    277435    TabOrder = 4
    278     OnChange = cboServiceChange
    279     CharsNeedMatch = 1
    280   end
    281   object cmdLexSearch: TButton [15]
    282     Left = 486
    283     Top = 93
    284     Width = 49
    285     Height = 21
    286     Anchors = [akTop, akRight]
    287     Caption = 'Lexicon'
    288     TabOrder = 8
    289     OnClick = cmdLexSearchClick
    290   end
    291   object gbInptOpt: TGroupBox [16]
    292     Left = 249
    293     Top = 36
    294     Width = 140
    295     Height = 45
    296     Anchors = [akTop, akRight]
    297     Caption = 'Patient will be seen as an:'
    298     TabOrder = 5
    299     object radInpatient: TRadioButton
    300       Left = 3
    301       Top = 20
    302       Width = 61
    303       Height = 17
    304       Caption = '&Inpatient'
    305       TabOrder = 0
    306       OnClick = radInpatientClick
    307     end
    308     object radOutpatient: TRadioButton
    309       Left = 67
    310       Top = 20
    311       Width = 71
    312       Height = 17
    313       Caption = '&Outpatient'
    314       TabOrder = 1
    315       OnClick = radOutpatientClick
    316     end
    317   end
    318   object txtProvDiag: TCaptionEdit [17]
    319     Left = 249
    320     Top = 93
    321     Width = 234
    322     Height = 21
    323     Anchors = [akTop, akRight]
    324     MaxLength = 180
    325     ParentShowHint = False
    326     PopupMenu = mnuPopProvDx
    327     ShowHint = True
    328     TabOrder = 7
    329     OnChange = txtProvDiagChange
    330     Caption = 'Provisional Diagnosis'
    331   end
    332   inherited cmdAccept: TButton
    333     Left = 387
    334     Top = 339
    335     Anchors = [akRight, akBottom]
    336     TabOrder = 10
    337     ExplicitLeft = 387
    338     ExplicitTop = 339
     436    ExplicitLeft = 427
     437    ExplicitTop = 382
    339438  end
    340439  inherited cmdQuit: TButton
    341     Left = 469
    342     Top = 339
     440    Left = 526
     441    Top = 382
    343442    Width = 64
    344443    Anchors = [akRight, akBottom]
    345     TabOrder = 11
    346     ExplicitLeft = 469
    347     ExplicitTop = 339
     444    TabOrder = 5
     445    ExplicitLeft = 526
     446    ExplicitTop = 382
    348447    ExplicitWidth = 64
    349448  end
    350449  inherited pnlMessage: TPanel
    351     Left = 50
    352     Top = 320
     450    Left = 13
     451    Top = 361
    353452    Width = 316
    354453    Anchors = [akLeft, akRight, akBottom]
    355     TabOrder = 12
    356     ExplicitLeft = 50
    357     ExplicitTop = 320
     454    TabOrder = 2
     455    ExplicitLeft = 13
     456    ExplicitTop = 361
    358457    ExplicitWidth = 316
    359458    inherited memMessage: TRichEdit
    … …  
    365464    Data = (
    366465      (
     466        'Component = memOrder'
     467        'Status = stsDefault')
     468      (
     469        'Component = cmdAccept'
     470        'Status = stsDefault')
     471      (
     472        'Component = cmdQuit'
     473        'Status = stsDefault')
     474      (
     475        'Component = pnlMessage'
     476        'Status = stsDefault')
     477      (
     478        'Component = memMessage'
     479        'Status = stsDefault')
     480      (
     481        'Component = frmODProc'
     482        'Status = stsDefault')
     483      (
     484        'Component = pnlMain'
     485        'Status = stsDefault')
     486      (
     487        'Component = pnlCombatVet'
     488        'Status = stsDefault')
     489      (
    367490        'Component = lblUrgency'
    368491        'Status = stsDefault')
    … …  
    416539        'Status = stsDefault')
    417540      (
    418         'Component = memOrder'
    419         'Status = stsDefault')
    420       (
    421         'Component = cmdAccept'
    422         'Status = stsDefault')
    423       (
    424         'Component = cmdQuit'
    425         'Status = stsDefault')
    426       (
    427         'Component = pnlMessage'
    428         'Status = stsDefault')
    429       (
    430         'Component = memMessage'
    431         'Status = stsDefault')
    432       (
    433         'Component = frmODProc'
     541        'Component = lblEarliest'
     542        'Status = stsDefault')
     543      (
     544        'Component = calEarliest'
     545        'Status = stsDefault')
     546      (
     547        'Component = lblLatest'
     548        'Status = stsDefault')
     549      (
     550        'Component = calLatest'
     551        'Status = stsDefault')
     552      (
     553        'Component = txtCombatVet'
     554        'Status = stsDefault')
     555      (
     556        'Component = servicelbl508'
    434557        'Status = stsDefault'))
    435558  end
    436559  object mnuPopProvDx: TPopupMenu
    437560    Left = 353
    438     Top = 77
     561    Top = 133
    439562    object mnuPopProvDxDelete: TMenuItem
    440563      Caption = 'Delete diagnosis'
    … …  
    444567  object popReason: TPopupMenu
    445568    OnPopup = popReasonPopup
    446     Left = 411
    447     Top = 169
     569    Left = 483
     570    Top = 337
    448571    object popReasonCut: TMenuItem
    449572      Caption = 'Cu&t'

  • cprs/trunk/CPRS-Chart/Consults/fODProc.pas

    r829 r1679  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
    8   Menus, VA508AccessibilityManager;
     8  Menus, ORDtTm, VA508AccessibilityManager;
    99
    1010type
    1111  TfrmODProc = class(TfrmODBase)
    12     cboUrgency: TORComboBox;
    13     cboPlace: TORComboBox;
    14     txtAttn: TORComboBox;
     12    pnlMain: TPanel;
     13    pnlCombatVet: TPanel;
    1514    lblProc: TLabel;
    16     cboProc: TORComboBox;
     15    lblService: TOROffsetLabel;
     16    lblReason: TLabel;
    1717    lblUrgency: TStaticText;
    1818    lblPlace: TStaticText;
    1919    lblAttn: TStaticText;
    2020    lblProvDiag: TStaticText;
     21    pnlReason: TPanel;
     22    memReason: TCaptionRichEdit;
     23    cboUrgency: TORComboBox;
     24    cboPlace: TORComboBox;
     25    txtAttn: TORComboBox;
     26    cboProc: TORComboBox;
    2127    cboCategory: TORComboBox;
    2228    cboService: TORComboBox;
    23     lblService: TOROffsetLabel;
     29    cmdLexSearch: TButton;
     30    gbInptOpt: TGroupBox;
     31    radInpatient: TRadioButton;
     32    radOutpatient: TRadioButton;
     33    txtProvDiag: TCaptionEdit;
     34    lblEarliest: TStaticText;
     35    calEarliest: TORDateBox;
     36    lblLatest: TStaticText;
     37    calLatest: TORDateBox;
    2438    mnuPopProvDx: TPopupMenu;
    2539    mnuPopProvDxDelete: TMenuItem;
    26     cmdLexSearch: TButton;
    2740    popReason: TPopupMenu;
    2841    popReasonCut: TMenuItem;
    … …  
    3144    popReasonPaste2: TMenuItem;
    3245    popReasonReformat: TMenuItem;
    33     pnlReason: TPanel;
    34     memReason: TCaptionRichEdit;
    35     gbInptOpt: TGroupBox;
    36     radInpatient: TRadioButton;
    37     radOutpatient: TRadioButton;
    38     txtProvDiag: TCaptionEdit;
    39     lblReason: TLabel;
     46    txtCombatVet: TVA508StaticText;
     47    servicelbl508: TVA508StaticText;
    4048    procedure FormCreate(Sender: TObject);
    4149    procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
    … …  
    6472    procedure FormResize(Sender: TObject);
    6573    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     74    procedure FormShow(Sender: TObject);
    6675  private
    6776    FLastProcID: string;
    … …  
    7483    function ShowPrerequisites: boolean;
    7584    procedure DoSetFontSize( FontSize: integer);
     85    procedure SetUpCombatVet;
     86    procedure updateService;
     87    procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
    7688  protected
    7789    procedure InitDialog; override;
    … …  
    8395  end;
    8496
     97
     98function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
     99
    85100implementation
    86101
    … …  
    89104uses
    90105    rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses,
    91     clipbrd, fPreReq, uTemplates, fFrame, uODBase,
    92   uVA508CPRSCompatibility;
     106    clipbrd, fPreReq, uTemplates, fFrame, uODBase, VA508AccessibilityRouter,
     107    uVA508CPRSCompatibility;
     108
    93109
    94110var
    95111  ProvDx:  TProvisionalDiagnosis;
    96112  GMRCREAF: string;
     113  OkToFreeProcDialog: boolean;
    97114
    98115const
    … …  
    108125  TX_INACTIVE_CODE_REQD     = 'Another code must be selected before the order can be saved.';
    109126  TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
     127  TX_PAST_DATE       = 'Earliest appropriate date must be today or later.';
     128  TX_BAD_DATES       = 'Latest appropriate date must be equal to or later than earliest date.';
     129
     130{ ********* Static Unit Methods ************ }
     131
     132function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
     133begin
     134  Result := true;
     135  if (dialog is TfrmODProc) then
     136    Result := OkToFreeProcDialog;
     137end;
     138
     139{ ********************* TfrmODProc Methods **************** }
    110140
    111141procedure TfrmODProc.FormCreate(Sender: TObject);
    … …  
    114144  AutoSizeDisabled := True;
    115145  inherited;
     146  OkToFreeProcDialog := False;
    116147  DoSetFontSize(MainFontSize);
    117148  AllowQuickOrder := True;
    … …  
    126157  cboProc.InitLongList('') ;
    127158  txtAttn.InitLongList('') ;
     159  calEarliest.Text := 'TODAY';
     160  //calLatest.Text := 'TODAY+30';
     161  PreserveControl(calEarliest);
     162  //PreserveControl(calLatest);
    128163  PreserveControl(txtAttn);
    129164  PreserveControl(cboProc);
     165  if (patient.CombatVet.IsEligible = True) then
     166   begin
     167     SetUpCombatVet;
     168   end
     169   else
     170    begin
     171      txtCombatVet.Enabled := False;
     172      pnlCombatVet.SendToBack;
     173    end;
    130174  InitDialog;
    131175end;
    … …  
    198242    SetControl(cboPlace,      'PLACE',     1);
    199243    SetControl(txtAttn,       'PROVIDER',  1);
     244    SetControl(calEarliest,   'EARLIEST',  1);
     245    //SetControl(calLatest,     'LATEST',    1);
    200246    cboProc.Enabled := False;
    201247    cboProc.Font.Color := clGrayText;
    … …  
    229275    if WasTemplateDialogCanceled then
    230276    begin
    231       AbortOrder := True;
     277      AbortOrder := True;   
     278      OkToFreeProcDialog := true;
     279      SetTemplateDialogCanceled(FALSE);
    232280      Close;
    233281      Exit;
    … …  
    238286    begin
    239287      AbortOrder := True;
     288      OkToFreeProcDialog := true;
     289      SetTemplateDialogCanceled(FALSE);
    240290      Close;
    241291      Exit;
    … …  
    258308  inherited;
    259309  if cboProc.ItemIEN = 0                  then SetError(TX_NO_PROC);
    260   if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
    261   if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
     310  if cboUrgency.ItemIEN = 0               then SetError(TX_NO_URGENCY);
     311  if cboPlace.ItemID = ''                 then SetError(TX_NO_PLACE);
    262312  if (not ContainsVisibleChar(memReason.Text))
    263313                                          then SetError(TX_NO_REASON);
    … …  
    265315  if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
    266316    begin
    267       if ProvDx.PromptMode = 'F' then
     317      if ProvDx.PromptMode = 'F'          then
    268318        SetError(TX_NO_DIAG)
    269319      else
    270320        SetError(TX_SELECT_DIAG);
    271321    end;
     322  if calEarliest.FMDateTime < FMToday     then SetError(TX_PAST_DATE);
     323  //if calLatest.FMDateTime < FMToday       then SetError(TX_PAST_DATE);
     324  //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
    272325end;
    273326
    … …  
    337390      else Responses.Update('ORDERABLE', 1, '', '');
    338391    end;
    339 (*  with cboProc       do if ItemIEN      > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
    340                                             else Responses.Update('ORDERABLE', 1, '', '');*)
    341   with cboService    do if ItemIEN      > 0 then Responses.Update('SERVICE', 1, ItemID, Text)
    342                                             else Responses.Update('SERVICE', 1, '', '');
     392  updateService();
    343393  with memReason     do if GetTextLen   > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
    344394  with cboCategory   do if ItemID     <> '' then Responses.Update('CLASS',     1, ItemID, Text);
    … …  
    346396  with cboPlace      do if ItemID     <> '' then Responses.Update('PLACE',     1, ItemID, Text);
    347397  with txtAttn       do if ItemIEN      > 0 then Responses.Update('PROVIDER',  1, ItemID, Text);
     398  with calEarliest   do if Length(Text) > 0 then Responses.Update('EARLIEST',  1, Text, Text);
     399  //with calLatest     do if Length(Text) > 0 then Responses.Update('LATEST',    1, Text,   Text);
    348400  if Length(ProvDx.Text)                > 0 then Responses.Update('MISC',      1, ProvDx.Text,   ProvDx.Text)
    349401   else Responses.Update('MISC',      1, '',   '');
    … …  
    415467      SetControl(cboPlace,      'PLACE',     1);
    416468      SetControl(txtAttn,       'PROVIDER',  1);
     469      SetControl(calEarliest,   'EARLIEST',  1);
     470      //SetControl(calLatest,     'LATEST',    1);
    417471      SetTemplateDialogCanceled(FALSE);
    418472      SetControl(memReason,     'COMMENT',   1);
    … …  
    588642end;
    589643
     644procedure TfrmODProc.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
     645begin
     646  if ScreenReaderSystemActive and not ctrl.Enabled then begin
     647    lbl.Enabled := True;
     648    lbl.Visible := True;
     649    lbl.Caption := lblService.Caption + ', ' + Text;
     650    lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left;
     651  end else
     652    lbl.Visible := false;
     653end;
     654
    590655procedure TfrmODProc.cboServiceChange(Sender: TObject);
    591656begin
    … …  
    813878end;
    814879
     880procedure TfrmODProc.updateService;
     881begin
     882  with cboService do
     883    if ItemIEN > 0 then
     884    begin
     885      setup508Label(Text, servicelbl508, cboService);
     886      Responses.Update('SERVICE', 1, ItemID, Text);
     887    end
     888    else begin
     889      Responses.Update('SERVICE', 1, '', '');
     890      setup508Label('No service selected.', servicelbl508, cboService);
     891    end;
     892end;
     893
    815894procedure TfrmODProc.DoSetFontSize(FontSize: integer);
    816895begin
    … …  
    840919begin
    841920  inherited;
    842   memOrder.Top := PnlReason.Top + PnlReason.Height + 5;
    843 
     921  if Patient.CombatVet.IsEligible then
     922  begin
     923    memOrder.Top := pnlCombatVet.Height + PnlReason.Top + PnlReason.Height + 7;
     924   end
     925  else
     926   begin
     927       memOrder.Top := PnlReason.Top + PnlReason.Height + 7;
     928   end;
     929
     930end;
     931
     932procedure TfrmODProc.FormShow(Sender: TObject);
     933begin
     934  inherited;
     935  setup508Label('No service selected.', servicelbl508, cboService);
    844936end;
    845937
    … …  
    850942end;
    851943
     944procedure TfrmODProc.SetUpCombatVet;
     945   begin
     946     pnlCombatVet.BringToFront;
     947     txtCombatVet.Enabled := True;
     948     txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
     949     pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
     950     pnlMain.Anchors := [akLeft,akTop,akRight];
     951     self.Height := self.Height + pnlCombatVet.Height;
     952     pnlMain.Anchors := [akLeft,akTop,akRight,akBottom];
     953  end;
     954
    852955end.
    853956

  • cprs/trunk/CPRS-Chart/Consults/fPreReq.pas

    r829 r1679  
    137137              with Lines do
    138138                begin
    139                   AddStrings(AHeader);
    140139                  for i := 0 to MaxLines do
    141140                    if i < memReport.Lines.Count then
    … …  
    157156                end;
    158157              until LastLine >= memReport.Lines.Count - 1;
    159             PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg);
     158            PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg, True);
    160159          end;
    161160      finally
    … …  
    185184begin
    186185  inherited;
     186  SetFormPosition(Self); //Get Saved Position & Size of Form
    187187  ResizeAnchoredFormToFont(Self);
    188   SetFormPosition(Self); //Get Saved Position & Size of Form
     188  //SetFormPosition(Self); //Get Saved Position & Size of Form
    189189end;
    190190

  • cprs/trunk/CPRS-Chart/Consults/rConsults.pas

    r829 r1679  
    9696function GetServicePrerequisites(Service: string): TStrings;
    9797procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
     98function IsProstheticsService(SvcIen: int64) : string;
    9899
    99100{ Clinical Procedures Specific}
    … …  
    354355      Findings              := Piece(x, U, 19)  ;
    355356      TIUResultNarrative    := StrToIntDef(Piece(x, U, 20),0);
     357      EarliestDate          := StrToFloatDef(Piece(x, U, 98), 0);
     358      //LatestDate            := StrToFloatDef(Piece(x, U, 99), 0); //dropped requirement WAT
    356359      //ProvDiagnosis         := Piece(x, U, 23);  NO!!!!! Up to 180 Characters!!!!
    357360      alist.delete(0) ;
    … …  
    668671         Urgency         := StrToIntDef(Piece(ExtractDefault(Dest, 'URGENCY'), U, 3), 0);
    669672         UrgencyName     := Piece(ExtractDefault(Dest, 'URGENCY'), U, 2);
     673         EarliestDate    := StrToFloatDef(Piece(ExtractDefault(Dest, 'EARLIEST'), U, 2), 0);
     674         //LatestDate      := StrToFloatDef(Piece(ExtractDefault(Dest, 'LATEST'), U, 2), 0); //dropped requirement WAT
    670675         Place           := Piece(ExtractDefault(Dest, 'PLACE'), U, 1);
    671676         PlaceName       := Piece(ExtractDefault(Dest, 'PLACE'), U, 2);
    … …  
    734739                Mult['10,' + IntToStr(i+1)] := NewComments.Strings[i];
    735740            end;
     741          if EarliestDate > 0 then
     742             Mult['11']  := 'GMRCERDT^'  + FloatToStr(EarliestDate);  //wat renamed v28
     743          {if LatestDate > 0 then
     744             Mult['12']  := 'GMRCLATE^'  + FloatToStr(LatestDate);} //dropped requirement WAT
    736745        end;
    737746      CallBroker;
    … …  
    836845end;
    837846
     847function IsProstheticsService(SvcIen : int64) : string;  //wat v28
     848 begin
     849   Result := sCallV('ORQQCN ISPROSVC', [SvcIen]);
     850 end;
     851
    838852initialization
    839853  uLastOrderedIEN := 0;

  • cprs/trunk/CPRS-Chart/Consults/uConsults.pas

    r829 r1679  
    44
    55uses
    6     SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls;
     6    SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls,
     7    Contnrs, DateUtils;
    78
    89type
    … …  
    3839    ProvDxCode: string;                     {  30.1}
    3940    RequestProcessingActivity: TStringList; {  40}
    40     //EarliestDate: TFMDateTime;
    41     //LatestDate: TFMDateTime;
     41    EarliestDate: TFMDateTime;
     42    //LatestDate: TFMDateTime; //dropped requirement WAT
    4243  end ;
    4344
    … …  
    5354    Urgency: integer;
    5455    UrgencyName: string;
    55     //EarliestDate: TFMDateTime;
    56     //LatestDate: TFMDateTime;
     56    EarliestDate: TFMDateTime;
     57    //LatestDate: TFMDateTime; //dropped requirement WAT
    5758    Place: string;
    5859    PlaceName: string;
    … …  
    259260procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode);
    260261var
    261   MyID, MyParent, Name, temp: string;
    262   i: Integer;
    263   ChildNode, tmpNode: TORTreeNode;
     262  MyID, MyParent, Name, item: string;
     263  i, Idx: Integer;
     264  ParentNode, ChildNode: TORTreeNode;
     265//  tmpNode: TORTreeNode;
    264266  HasChildren: Boolean;
     267//  AllNodes: TStringList;
     268  ParentNodes: TStringList;
     269//  List: TList;
     270//  Lists: TObjectList;
     271//  bad: boolean;
     272
     273// Former code was only filtering out half the duplicates, depending on
     274// how they appeared in the tree.  Commented out code filters out all the duplicates,
     275// and still keeps the fast tree build.  However, CPRS Clinical Workgroup determined
     276// that no duplicates should be filtered out.  Code kept here in order to keep fast filter
     277// logic, in case duplicates are ever filtered out in the future.
     278
     279{
     280  procedure FilterOutDuplicates;
     281  var
     282    j: integer;
     283  begin
     284    bad := false;
     285    if AllNodes.Find(MyID, Idx) then
     286    begin
     287      if AllNodes.Objects[Idx] is TORTreeNode then
     288      begin
     289        tmpNode := TORTreeNode(AllNodes.Objects[Idx]);
     290        bad := tmpNode.HasAsParent(ParentNode);
     291        if (not bad) and assigned(tmpNode.Parent) then
     292          bad := ParentNode.HasAsParent(tmpNode.Parent);
     293      end
     294      else
     295      begin
     296        bad := False;
     297        List := TList(AllNodes.Objects[Idx]);
     298        for j := 0 to List.Count - 1 do
     299        begin
     300          tmpNode := TORTreeNode(List[j]);
     301          bad := TORTreeNode(List[j]).HasAsParent(ParentNode);
     302          if (not bad) and assigned(tmpNode.Parent) then
     303            bad := ParentNode.HasAsParent(tmpNode.Parent);
     304          if bad then break;
     305        end;
     306      end;
     307    end;
     308  end;
     309
     310  procedure AddNode;
     311  begin
     312    if AllNodes.Find(MyID, Idx) then
     313    begin
     314      if AllNodes.Objects[Idx] is TORTreeNode then
     315      begin
     316        List := TList.Create;
     317        Lists.Add(List);
     318        List.Add(AllNodes.Objects[Idx]);
     319        AllNodes.Objects[Idx] := List;
     320      end
     321      else
     322        List := TList(AllNodes.Objects[Idx]);
     323      List.Add(ChildNode);
     324    end
     325    else
     326      AllNodes.AddObject(MyId, ChildNode);
     327  end;
     328}
     329
    265330begin
    266331  Tree.Items.BeginUpdate;
    267   with SvcList do for i := 0 to Count - 1 do
    268     begin
    269       if Piece(Strings[i], U, 5) = 'S' then Continue;  // V19.4 {rv}
    270       //if Piece(Strings[i], U, 6) = 'S' then Continue;
    271       MyParent := Piece(Strings[i], U, 3);
    272       if (MyParent = Parent) then
    273         begin
    274           MyID := Piece(Strings[i], U, 1);
    275           Name := Piece(Strings[i], U, 2);
    276           temp  := Strings[i];
    277           tmpNode := nil;
    278           HasChildren := Piece(Strings[i], U, 4) = '+';
    279           if Node <> nil then if Node.HasChildren then
    280             tmpNode := Tree.FindPieceNode(MyID, 1, U, Node);
    281           if (tmpNode <> nil) and tmpNode.HasAsParent(Node) then
    282             Continue
    283           else
    284             begin
    285               ChildNode := TORTreeNode(Tree.Items.AddChild(Node, Name));
    286               ChildNode.StringData := temp;
    287               if HasChildren then BuildServiceTree(Tree, SvcList, MyID, ChildNode);
    288             end;
    289         end;
     332  ParentNodes := TStringList.Create;
     333//  AllNodes := TStringList.Create;
     334//  Lists := TObjectList.Create;
     335  try
     336    ParentNodes.Sorted := True;
     337//    AllNodes.Sorted := True;
     338    for i := 0 to SvcList.Count - 1 do
     339    begin
     340      item := SvcList[i];
     341      if Piece(item, U, 5) = 'S' then Continue;
     342      MyParent := Piece(item, U, 3);
     343      MyID := Piece(item, U, 1);
     344      if not ParentNodes.Find(MyParent, Idx) then
     345        ParentNode := nil
     346      else
     347      begin
     348        ParentNode := TORTreeNode(ParentNodes.Objects[Idx]);
     349//        FilterOutDuplicates;
     350//        if bad then Continue;
     351      end;
     352      Name := Piece(item, U, 2);
     353      HasChildren := Piece(item, U, 4) = '+';
     354      ChildNode := TORTreeNode(Tree.Items.AddChild(ParentNode, Name));
     355      ChildNode.StringData := item;
     356//      AddNode;
     357      if HasChildren then
     358        ParentNodes.AddObject(MyID, ChildNode);
    290359    end;
     360  finally
     361    ParentNodes.Free;
     362//    AllNodes.Free;
     363//    Lists.Free;
     364  end;
    291365  Tree.Items.EndUpdate;
    292366end;
Note: See TracChangeset for help on using the changeset viewer.