Ignore:
Timestamp:
Jul 6, 2008, 8:20:14 PM (16 years ago)
Author:
Kevin Toppenberg
Message:

Uploading from OR_30_258

Location:
cprs/branches/foia-cprs/CPRS-Chart/Orders
Files:
3 added
53 edited

Legend:

Unmodified
Added
Removed

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOCAccept.dfm

    r459 r460  
    1111  TextHeight = 13
    1212  object memChecks: TRichEdit
    13     Left = 8
    14     Top = 8
    15     Width = 454
    16     Height = 120
     13    Left = 0
     14    Top = 0
     15    Width = 472
     16    Height = 136
     17    Align = alClient
    1718    ReadOnly = True
    1819    ScrollBars = ssVertical
    19     TabOrder = 2
     20    TabOrder = 0
    2021    WantReturns = False
    2122  end
    22   object cmdAccept: TButton
    23     Left = 148
    24     Top = 140
    25     Width = 80
    26     Height = 21
    27     Caption = 'Accept Order'
    28     Default = True
    29     ModalResult = 6
    30     TabOrder = 0
    31   end
    32   object cmdCancel: TButton
    33     Left = 244
    34     Top = 140
    35     Width = 80
    36     Height = 21
    37     Cancel = True
    38     Caption = 'Cancel Order'
    39     ModalResult = 7
     23  object pnlBottom: TPanel
     24    Left = 0
     25    Top = 136
     26    Width = 472
     27    Height = 33
     28    Align = alBottom
     29    BevelOuter = bvNone
    4030    TabOrder = 1
     31    object cmdAccept: TButton
     32      Left = 148
     33      Top = 7
     34      Width = 80
     35      Height = 21
     36      Caption = 'Accept Order'
     37      Default = True
     38      ModalResult = 6
     39      TabOrder = 0
     40    end
     41    object cmdCancel: TButton
     42      Left = 244
     43      Top = 7
     44      Width = 80
     45      Height = 21
     46      Cancel = True
     47      Caption = 'Cancel Order'
     48      ModalResult = 7
     49      TabOrder = 1
     50    end
    4151  end
    4252end

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOCAccept.pas

    r459 r460  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls;
    88
    99type
    1010  TfrmOCAccept = class(TfrmAutoSz)
    1111    memChecks: TRichEdit;
     12    pnlBottom: TPanel;
    1213    cmdAccept: TButton;
    1314    cmdCancel: TButton;

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOCSession.dfm

    r459 r460  
    11inherited frmOCSession: TfrmOCSession
    2   Left = 220
    3   Top = 392
     2  Left = 365
     3  Top = 221
    44  Width = 504
    55  Height = 298
    … …  
    77  Caption = 'Order Checks'
    88  Position = poScreenCenter
     9  ShowHint = True
     10  OnClose = FormClose
     11  OnShow = FormShow
    912  PixelsPerInch = 96
    1013  TextHeight = 13
    11   object lblJustify: TLabel
    12     Left = 8
    13     Top = 195
    14     Width = 248
    15     Height = 13
    16     Caption = 'Enter justification for overriding critical order checks -'
    17   end
    18   object lstChecks: TListBox
    19     Left = 8
    20     Top = 8
    21     Width = 480
    22     Height = 149
     14  object lstChecks: TCaptionListBox
     15    Left = 0
     16    Top = 0
     17    Width = 496
     18    Height = 160
     19    Style = lbOwnerDrawVariable
     20    Align = alClient
    2321    ItemHeight = 13
    2422    MultiSelect = True
    25     Style = lbOwnerDrawVariable
    26     TabOrder = 0
     23    ParentShowHint = False
     24    ShowHint = True
     25    TabOrder = 1
    2726    OnDrawItem = lstChecksDrawItem
    2827    OnMeasureItem = lstChecksMeasureItem
     28    HintOnItem = True
    2929  end
    30   object txtJustify: TCaptionEdit
    31     Left = 8
    32     Top = 209
    33     Width = 480
    34     Height = 21
    35     MaxLength = 80
    36     TabOrder = 2
    37     Caption = 'Enter justification for overriding critical order checks -'
    38   end
    39   object cmdCancelOrder: TButton
    40     Left = 356
    41     Top = 162
    42     Width = 133
    43     Height = 21
    44     Caption = 'Cancel Selected Order(s)'
    45     TabOrder = 1
    46     OnClick = cmdCancelOrderClick
    47   end
    48   object cmdContinue: TButton
    49     Left = 212
    50     Top = 242
    51     Width = 72
    52     Height = 21
    53     Caption = 'Continue'
    54     TabOrder = 3
    55     OnClick = cmdContinueClick
     30  object pnlBottom: TPanel
     31    Left = 0
     32    Top = 160
     33    Width = 496
     34    Height = 111
     35    Align = alBottom
     36    BevelOuter = bvNone
     37    TabOrder = 0
     38    DesignSize = (
     39      496
     40      111)
     41    object lblJustify: TLabel
     42      Left = 8
     43      Top = 34
     44      Width = 248
     45      Height = 13
     46      Anchors = [akLeft, akTop, akRight]
     47      Caption = 'Enter justification for overriding critical order checks -'
     48    end
     49    object txtJustify: TCaptionEdit
     50      Left = 8
     51      Top = 50
     52      Width = 480
     53      Height = 21
     54      Anchors = [akLeft, akTop, akRight]
     55      MaxLength = 80
     56      TabOrder = 0
     57      OnKeyDown = txtJustifyKeyDown
     58      Caption = 'Enter justification for overriding critical order checks -'
     59    end
     60    object cmdCancelOrder: TButton
     61      Left = 356
     62      Top = 5
     63      Width = 133
     64      Height = 21
     65      Anchors = [akLeft, akTop, akRight]
     66      Caption = 'Cancel Selected Order(s)'
     67      TabOrder = 2
     68      OnClick = cmdCancelOrderClick
     69    end
     70    object cmdContinue: TButton
     71      Left = 212
     72      Top = 82
     73      Width = 72
     74      Height = 21
     75      Anchors = [akLeft, akTop, akRight]
     76      Caption = 'Continue'
     77      TabOrder = 3
     78      OnClick = cmdContinueClick
     79    end
    5680  end
    5781end

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOCSession.pas

    r459 r460  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, uConst, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls;
    88
    99type
    1010  TfrmOCSession = class(TfrmAutoSz)
    11     lstChecks: TListBox;
     11    lstChecks: TCaptionListBox;
     12    pnlBottom: TPanel;
     13    lblJustify: TLabel;
    1214    txtJustify: TCaptionEdit;
    13     lblJustify: TLabel;
    1415    cmdCancelOrder: TButton;
    1516    cmdContinue: TButton;
    … …  
    2021    procedure lstChecksDrawItem(Control: TWinControl; Index: Integer;
    2122      Rect: TRect; State: TOwnerDrawState);
     23    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     24    procedure FormShow(Sender: TObject);
     25    procedure FormResize(Sender: TObject);
     26    procedure txtJustifyKeyDown(Sender: TObject; var Key: Word;
     27      Shift: TShiftState);
    2228  private
    2329    FCritical: Boolean;
    … …  
    3642{$R *.DFM}
    3743
    38 uses rOrders, uCore;
     44uses rOrders, uCore, rMisc;
    3945
    4046type
    … …  
    4955var
    5056  uCheckedOrders: TList;
     57  FOldHintHidePause: integer;
    5158
    5259constructor TOCRec.Create(const AnID: string);
    … …  
    5461  OrderID := AnID;
    5562  Checks := TStringList.Create;
     63  FOldHintHidePause := Application.HintHidePause;
    5664end;
    5765
    5866destructor TOCRec.Destroy;
    5967begin
     68  Application.HintHidePause := FOldHintHidePause;
    6069  Checks.Free;
    6170  inherited Destroy;
    … …  
    141150        frmOCSession.SetReqJustify;
    142151        MessageBeep(MB_ICONASTERISK);
     152        if frmOCSession.Visible then frmOCSession.SetFocus;
    143153        frmOCSession.ShowModal;
    144154      finally
    … …  
    166176  lblJustify.Visible := FCritical;
    167177  txtJustify.Visible := FCritical;
    168 end;
    169 
    170 procedure TfrmOCSession.lstChecksMeasureItem(Control: TWinControl; Index: Integer;
    171   var Height: Integer);
     178
     179end;
     180
     181procedure TfrmOCSession.lstChecksMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
    172182var
    173183  i, AHt, TotalHt: Integer;
    … …  
    177187begin
    178188  inherited;
     189
    179190  with lstChecks do
    180   begin
    181     if Index >= uCheckedOrders.Count then Exit;
    182     OCRec := TOCRec(uCheckedOrders.Items[Index]);
    183     ARect := ItemRect(Index);
    184     ARect.Left := ARect.Left + 2;
    185     AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect,
    186                     DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2;
    187     TotalHt := AHt;
    188     for i := 0 to OCRec.Checks.Count - 1 do
    189     begin
    190       ARect := ItemRect(Index);
    191       ARect.Left := ARect.Left + 10;
    192       x := Piece(OCRec.Checks[i], U, 3);
    193       AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect,
    194                       DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
    195       TotalHt := TotalHt + AHt;
    196     end;
    197   end;
     191     begin
     192       if Index >= uCheckedOrders.Count then Exit;
     193       OCRec := TOCRec(uCheckedOrders.Items[Index]);
     194       ARect := ItemRect(Index);
     195       ARect.Left := ARect.Left + 2;
     196       AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
     197       TotalHt := AHt;
     198
     199       for i := 0 to OCRec.Checks.Count - 1 do
     200          begin
     201            ARect := ItemRect(Index);
     202            ARect.Left := ARect.Left + 10;
     203            x := Piece(OCRec.Checks[i], U, 3);
     204            AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
     205            TotalHt := TotalHt + AHt;
     206          end;
     207     end;
    198208  Height := TotalHt + 2; // add 2 for focus rectangle
    199 end;
    200 
    201 procedure TfrmOCSession.lstChecksDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
    202   State: TOwnerDrawState);
     209  if Height > 255 then Height := 255; //CQ7178
     210end;
     211
     212procedure TfrmOCSession.lstChecksDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    203213var
    204214  i, AHt: Integer;
    … …  
    208218begin
    209219  inherited;
     220
    210221  with lstChecks do
    211   begin
    212     if Index >= uCheckedOrders.Count then Exit;
    213     OCRec := TOCRec(uCheckedOrders.Items[Index]);
    214     ARect := ItemRect(Index);
    215     AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect,
    216                     DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2;
    217     ARect.Left := ARect.Left + 10;
    218     ARect.Top  := ARect.Top + AHt;
    219     for i := 0 to OCRec.Checks.Count - 1 do
    220     begin
    221       x := Piece(OCRec.Checks[i], U, 3);
    222       if not (odSelected in State) then
    223       begin
    224         if (Piece(OCRec.Checks[i], U, 2) = '1')
    225           then
     222     begin
     223       if Index >= uCheckedOrders.Count then Exit;
     224       OCRec := TOCRec(uCheckedOrders.Items[Index]);
     225       ARect := ItemRect(Index);
     226       AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
     227       ARect.Left := ARect.Left + 10;
     228       ARect.Top  := ARect.Top + AHt;
     229       for i := 0 to OCRec.Checks.Count - 1 do
    226230          begin
    227             if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
    228               Canvas.Font.Color := clBlue;
    229             Canvas.Font.Style := [fsUnderline];
    230           end
    231           else Canvas.Font.Color := clWindowText;
    232       end;
    233       AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect,
    234                       DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
    235       ARect.Top  := ARect.Top + AHt;
    236     end;
    237   end;
     231            x := Piece(OCRec.Checks[i], U, 3);
     232            if not (odSelected in State) then
     233               begin
     234                 if (Piece(OCRec.Checks[i], U, 2) = '1') then
     235                   begin
     236                     if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
     237                       Canvas.Font.Color := clBlue;
     238                     Canvas.Font.Style := [fsUnderline];
     239                   end
     240                 else Canvas.Font.Color := clWindowText;
     241               end;
     242            AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
     243            ARect.Top  := ARect.Top + AHt;
     244        end;
     245     end;
     246
    238247end;
    239248
    … …  
    268277  if FCritical and ((Length(txtJustify.Text) < 2) or not ContainsVisibleChar(txtJustify.Text)) then
    269278  begin
    270     InfoBox('A justification for overriding critical order checks is required.',
     279     InfoBox('A justification for overriding critical order checks is required.',
    271280            'Justification Required', MB_OK);
    272281    Exit;
    … …  
    278287end;
    279288
     289procedure TfrmOCSession.FormClose(Sender: TObject;
     290  var Action: TCloseAction);
     291begin
     292  inherited;
     293  SaveUserBounds(Self); //Save Position & Size of Form
     294end;
     295
     296procedure TfrmOCSession.FormShow(Sender: TObject);
     297begin
     298  inherited;
     299  SetFormPosition(Self); //Get Saved Position & Size of Form
     300end;
     301
     302
     303procedure TfrmOCSession.FormResize(Sender: TObject);
     304begin
     305  //TfrmAutoSz has defect must call inherited Resize for the resize to function.
     306  inherited;
     307end;
     308
     309procedure TfrmOCSession.txtJustifyKeyDown(Sender: TObject; var Key: Word;
     310  Shift: TShiftState);
     311begin
     312  inherited;
     313  //GE CQ9540  activate Return key, behave as "Continue" buttom clicked.
     314  if Key = VK_RETURN then cmdContinueClick(self);
     315end;
     316
    280317end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODAllgy.dfm

    r459 r460  
    184184    TabOrder = 3
    185185    OnChange = ControlChange
     186    CharsNeedMatch = 1
    186187  end
    187188  object grpObsHist: TRadioGroup
    … …  
    260261    OnChange = ControlChange
    261262    OnNeedData = cboOriginatorNeedData
     263    CharsNeedMatch = 1
    262264  end
    263265  object cboSymptoms: TORComboBox
    … …  
    285287    OnMouseClick = cboSymptomsMouseClick
    286288    OnNeedData = cboSymptomsNeedData
     289    CharsNeedMatch = 1
    287290  end
    288291  object btnCurrent: TButton
    … …  
    328331    TabOrder = 11
    329332    OnChange = ControlChange
     333    CharsNeedMatch = 1
    330334  end
    331335  object btnRemove: TButton

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODAllgy.pas

    r459 r460  
    496496
    497497procedure TfrmODAllergy.cboSymptomsMouseClick(Sender: TObject);
     498var
     499  x: string;
    498500begin
    499501  inherited;
    … …  
    501503  Changing := True;
    502504  if lstSelectedSymptoms.SelectByID(cboSymptoms.ItemID) > -1 then exit;
     505  with cboSymptoms do
     506    if Piece(Items[ItemIndex], U, 3) <> '' then
     507      x := ItemID + U + Piece(Items[ItemIndex], U, 3)
     508    else
     509      x := ItemID + U + Piece(Items[ItemIndex], U, 2);
    503510  with lstSelectedSymptoms do
    504511    begin
    505       Items.Add(cboSymptoms.Items[cboSymptoms.ItemIndex]);
     512      Items.Add(x);
    506513      SelectByID(cboSymptoms.ItemID);
    507514    end;

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODAuto.pas

    r459 r460  
    2424
    2525uses rODBase, rOrders, fTemplateDialog, uTemplateFields, rTemplates, uConst, uTemplates,
    26      rConsults;
     26     rConsults, uCore, uODBase;
    2727
    2828procedure TfrmODAuto.InitDialog;
    … …  
    3838  LType: TTemplateLinkType;
    3939  IEN: integer;
     40  HasObjects: boolean;
    4041
    4142begin
    … …  
    4445  LType := DisplayGroupToLinkType(Responses.DisplayGroup);
    4546  tmp := Responses.EValueFor('COMMENT', 1);
     47  ExpandOrderObjects(tmp, HasObjects);
     48  Responses.OrderContainsObjects := Responses.OrderContainsObjects or HasObjects;
    4649  if (LType <> ltNone) or HasTemplateField(tmp) then
    4750  begin
    … …  
    5659    else
    5760      CheckBoilerplate4Fields(tmp, cptn);
    58      
     61
    5962    if tmp <> '' then
    6063      Responses.Update('COMMENT', 1, TX_WPTYPE, tmp)

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODBase.dfm

    r459 r460  
    44  Width = 528
    55  Height = 275
     6  HorzScrollBar.Range = 500
     7  HorzScrollBar.Tracking = True
     8  HorzScrollBar.Visible = True
     9  VertScrollBar.Range = 225
     10  VertScrollBar.Visible = True
     11  AutoScroll = False
    612  BorderIcons = [biSystemMenu]
    713  Caption = ''

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODBase.pas

    r459 r460  
    6262    FLogTime:   TFMDateTime;
    6363    FViewName: string;
     64    FCancel: boolean;
     65    FOrderContainsObjects: boolean;
    6466    function FindResponseByIEN(APromptIEN, AnInstance: Integer): TResponse;
    6567    function GetOrderText: string;
    … …  
    8385    function GetIENForPrompt(const APromptID: string): Integer;
    8486    function FindResponseByName(const APromptID: string; AnInstance: Integer): TResponse;
     87    function PromptExists(const APromptID: string):boolean;
    8588    function InstanceCount(const APromptID: string): Integer;
    8689    function IValueFor(const APromptID: string; AnInstance: Integer): string;
    … …  
    9699      const AnIValue, AnEValue: string);
    97100    property Dialog: string            read FDialog         write SetDialog;
    98     property DisplayGroup: Integer     read FDisplayGroup;
     101    property DisplayGroup: Integer     read FDisplayGroup   write FDisplayGroup;
    99102    property CopyOrder:    string      read FCopyOrder      write SetCopyOrder;
    100103    property EditOrder:    string      read FEditOrder;  //  write SetEditOrder;
    … …  
    110113    property VarTrailing:  string      read FVarTrailing    write FVarTrailing;
    111114    property TheList:      TList       read FResponseList   write FResponseList;
     115    property Cancel:       boolean     read FCancel         write FCancel;
     116    property OrderContainsObjects: boolean read FOrderContainsObjects write FOrderContainsObjects;
    112117  end;
    113118
    … …  
    241246uses fOCAccept, uODBase, rCore, rMisc, fODMessage,
    242247  fTemplateDialog, uEventHooks, uTemplates, rConsults,fOrders,uOrders,
    243   fFrame, uTemplateFields;
     248  fFrame, uTemplateFields, fClinicWardMeds;
    244249
    245250const
    … …  
    583588procedure TResponses.SetCopyOrder(const AnID: string);
    584589{ sets responses to the values for an order that is created by copying }
     590var
     591  HasObjects: boolean;
    585592begin
    586593  if AnID = '' then
    … …  
    590597  end;
    591598  Clear;
    592   LoadResponses(FResponseList, AnID);                      // Example AnID=C123456;1-3604
     599  LoadResponses(FResponseList, AnID, HasObjects);                      // Example AnID=C123456;1-3604
    593600  FCopyOrder := Copy(Piece(AnID, '-', 1), 2, Length(AnID));
     601  FOrderContainsObjects := HasObjects;
    594602end;
    595603
    596604procedure TResponses.SetEditOrder(const AnID: string);
    597605{ sets responses to the values for an order that is about to be edited }
     606var
     607  HasObjects: boolean;
    598608begin
    599609  Clear;
    600   LoadResponses(FResponseList, AnID);                      // Example AnID=X123456;1
     610  LoadResponses(FResponseList, AnID, HasObjects);                      // Example AnID=X123456;1
    601611  FEditOrder := Copy(Piece(AnID, '-', 1), 2, Length(AnID));
     612  FOrderContainsObjects := HasObjects;
    602613end;
    603614
    604615procedure TResponses.SetQuickOrder(AnIEN: Integer);
    605616{ sets responses to a quick order value - this is used by the QuickOrder property}
     617var
     618  HasObjects: boolean;
    606619begin
    607620  Clear;
    608   LoadResponses(FResponseList, IntToStr(AnIEN));           // Example AnIEN=134
     621  LoadResponses(FResponseList, IntToStr(AnIEN), HasObjects);           // Example AnIEN=134
    609622  FQuickOrder := AnIEN;
     623  FOrderContainsObjects := HasObjects;
    610624end;
    611625
    612626procedure TResponses.SetQuickOrderByID(const AnID: string);
    613627{ sets responses to a quick order value }
     628var
     629  HasObjects: boolean;
    614630begin
    615631  Clear;
    616   LoadResponses(FResponseList, AnID);                      // Example AnID=134-3645
     632  LoadResponses(FResponseList, AnID, HasObjects);                      // Example AnID=134-3645
    617633  FQuickOrder := StrToIntDef(Piece(AnID, '-', 1), 0);      // 2nd '-' piece is $H seconds
     634  FOrderContainsObjects := HasObjects;
    618635end;
    619636
    … …  
    671688      break;
    672689    end;
     690end;
     691
     692function TResponses.PromptExists(const APromptID: string): boolean;
     693var
     694  i: Integer;
     695begin
     696  Result := False;
     697  with FPrompts do for i := 0 to Count - 1 do with TPrompt(Items[i]) do
     698    if (ID = APromptID) then Result :=  True;
    673699end;
    674700
    … …  
    958984  APtEvtPtr: string;
    959985begin
     986  //IMOLoc := 0;
    960987  NewPtEvtPtr := 0;
    961988  QOUDGroup := False;
    … …  
    9841011    if IsIMODialog then
    9851012      DGroup := ClinDisp;
     1013    //AGP Change 26.35, 26.41 8518 added text order
     1014    //AGP Change 26.55 remove IMO functionality for inpatient
     1015    (*if (Patient.Inpatient = true) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and
     1016      ((ConstructOrder.DialogName = 'PSJ OR PAT OE') or (ConstructOrder.DialogName = 'PSJI OR PAT FLUID OE') or
     1017      (ConstructOrder.DialogName = 'OR GXTEXT WORD PROCESSING ORDE')) and
     1018      ((FEditOrder = '') and (Self.FEventName = '') and (Self.FCopyOrder = '')) then
     1019      begin
     1020       if frmClinicWardMeds.ClinicOrWardLocation(Encounter.location) = Encounter.Location then
     1021          begin
     1022            ConstructOrder.IsIMODialog := True;
     1023            ConstructOrder.DGroup := ClinDisp;
     1024          end
     1025       else IMOLoc := Patient.Location;
     1026      end; *)
     1027    //AGP Change 26.51, change logic to set text orders to IMO for outpatients at an outpatient location.
     1028    //AGP Text orders are only treated as IMO if the order display group is a nursing display group
     1029    if (Patient.Inpatient = False) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and
     1030       (((pos('OR GXTEXT WORD PROCESSING ORDE',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or
     1031       ((ConstructOrder.DialogName = 'OR GXMISC GENERAL') and (ConstructOrder.DGroup = NurDisp)) or
     1032       ((ConstructOrder.DialogName = 'OR GXTEXT TEXT ONLY ORDER') and (ConstructOrder.DGroup = NurDisp))) and //AGP Change CQ #10757
     1033      ((FEditOrder = '') and (Self.FEventName = '') and (Self.FCopyOrder = '')) then
     1034         begin
     1035            ConstructOrder.IsIMODialog := True;
     1036            ConstructOrder.DGroup := ClinDisp;
     1037          end;
    9861038    IsEventDefaultOR := EventDefaultOD;
    9871039    if IsUDGroup or QOUDGroup then
    … …  
    10031055      APtEvtPtr   := IntToStr(EventExist(Patient.DFN, FEventIFN));
    10041056      PTEventPtr  := APtEvtPtr;
     1057      //PutNewOrder(AnOrder, ConstructOrder, OrderSource, IMOLoc);
    10051058      PutNewOrder(AnOrder, ConstructOrder, OrderSource);
    10061059      if not SaveAsCurrent then
    … …  
    10121065    else
    10131066    begin
     1067      //PutNewOrder(AnOrder, ConstructOrder, OrderSource, IMOLoc);
    10141068      PutNewOrder(AnOrder, ConstructOrder, OrderSource);
    10151069      if not SaveAsCurrent then
    … …  
    10641118  AResponse: TResponse;
    10651119  IEN: integer;
     1120  HasObjects: boolean;
    10661121
    10671122  procedure AssignBPText(List: TStrings; const Value: string);
    … …  
    10801135      else         IEN := 0;
    10811136    end;
     1137    ExpandOrderObjects(tmp, HasObjects);
     1138    FOrderContainsObjects := FOrderContainsObjects or HasObjects;
    10821139    if IEN <> 0 then
    10831140      begin
    … …  
    10911148    else
    10921149      CheckBoilerplate4Fields(tmp, cptn);
    1093 
    10941150    List.Text := tmp;
    10951151  end;
    … …  
    13261382  if (Encounter.Provider = 0) or (PersonHasKey(Encounter.Provider, 'PROVIDER') = False)
    13271383    then AnErrMsg := TX_NO_PROVIDER;
     1384  if IsPFSSActive and Responses.PromptExists('VISITSTR') then
     1385    Responses.Update('VISITSTR', 1, Encounter.VisitStr, Encounter.VisitStr);
    13281386end;
    13291387
    … …  
    14321490  if not AcceptOrderChecks then
    14331491  begin
     1492    if AskAnotherOrder(DialogIEN) then
     1493        InitDialog           // ClearDialogControls is in InitDialog
     1494      else
     1495        begin
     1496          ClearDialogControls;    // to allow form to close without prompting to save order
     1497          Close;
     1498        end;
    14341499    Result := False;
    14351500    Exit;
    … …  
    14971562  CIDCOkToSave := False;
    14981563  alreadyClosed := False;
     1564  self.Responses.Cancel := False;
    14991565  if frmOrders <> nil then
    15001566  begin
    … …  
    15891655begin
    15901656  inherited;
     1657  //self.Responses.Cancel := False;
    15911658  if User.NoOrdering then Exit;
    15921659  if FAbortOrder then exit;
    … …  
    17261793end;
    17271794
     1795
    17281796end.
    17291797

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODDiet.dfm

    r459 r460  
    11inherited frmODDiet: TfrmODDiet
    2   Left = 404
    3   Top = 199
     2  Left = 541
     3  Top = 398
     4  Width = 532
     5  Height = 291
    46  Caption = 'Diet Order'
    57  OnKeyDown = FormKeyDown
    … …  
    911    Left = 0
    1012    Top = 0
    11     Width = 520
    12     Height = 186
     13    Width = 524
     14    Height = 194
    1315    ActivePage = pgeOutPt
    1416    Align = alTop
    … …  
    8688        OnMouseClick = cboDietAvailMouseClick
    8789        OnNeedData = cboDietAvailNeedData
     90        CharsNeedMatch = 1
    8891      end
    8992      object lstDietSelect: TORListBox
    … …  
    165168        TabOrder = 6
    166169        OnChange = DietChange
     170        CharsNeedMatch = 1
    167171      end
    168172      object chkCancelTubefeeding: TCheckBox
    … …  
    195199      end
    196200      object lblOPDietAvail: TLabel
    197         Left = 127
    198         Top = 0
     201        Left = 0
     202        Top = 1
    199203        Width = 70
    200204        Height = 13
    … …  
    203207      object lblOPComment: TLabel
    204208        Left = 4
    205         Top = 117
     209        Top = 128
    206210        Width = 92
    207211        Height = 13
    … …  
    216220      end
    217221      object lblOPSelect: TLabel
    218         Left = 127
    219         Top = 38
     222        Left = 0
     223        Top = 39
    220224        Width = 64
    221225        Height = 13
    … …  
    223227      end
    224228      object grpOPMeal: TKeyClickRadioGroup
    225         Left = 5
    226         Top = 5
     229        Left = 168
     230        Top = 11
    227231        Width = 110
    228232        Height = 107
    … …  
    234238          'Evening'
    235239          '<none selected>')
    236         TabOrder = 0
     240        TabOrder = 3
    237241        TabStop = True
    238242        OnClick = grpOPMealClick
    … …  
    242246        Top = 5
    243247        Width = 93
    244         Height = 149
     248        Height = 155
    245249        Caption = 'Days of Week'
    246250        TabOrder = 8
    … …  
    334338      end
    335339      object cboOPDietAvail: TORComboBox
    336         Left = 127
    337         Top = 15
     340        Left = 0
     341        Top = 16
    338342        Width = 157
    339343        Height = 21
    … …  
    341345        AutoSelect = True
    342346        Caption = 'Available Diet Components'
    343         Color = clWindow
    344         DropDownCount = 8
    345         ItemHeight = 13
    346         ItemTipColor = clWindow
    347         ItemTipEnable = True
    348         ListItemsOnly = True
    349         LongList = True
    350         LookupPiece = 0
    351         MaxLength = 0
    352         Pieces = '2'
    353         Sorted = False
    354         SynonymChars = '<>'
    355         TabOrder = 1
    356         OnExit = cboDietAvailExit
    357         OnMouseClick = cboOPDietAvailMouseClick
    358         OnNeedData = cboOPDietAvailNeedData
    359       end
    360       object txtOPDietComment: TCaptionEdit
    361         Left = 4
    362         Top = 131
    363         Width = 404
    364         Height = 21
    365         MaxLength = 80
    366         TabOrder = 11
    367         OnChange = OPChange
    368         Caption = 'Special Instructions'
    369       end
    370       object cboOPDelivery: TORComboBox
    371         Left = 292
    372         Top = 86
    373         Width = 120
    374         Height = 21
    375         Style = orcsDropDown
    376         AutoSelect = True
    377         Caption = 'Delivery'
    378347        Color = clWindow
    379348        DropDownCount = 8
    … …  
    388357        Sorted = False
    389358        SynonymChars = '<>'
    390         TabOrder = 9
     359        TabOrder = 0
     360        OnExit = cboDietAvailExit
     361        OnKeyDown = cboOPDietAvailKeyDown
     362        OnMouseClick = cboOPDietAvailMouseClick
     363        CharsNeedMatch = 1
     364      end
     365      object txtOPDietComment: TCaptionEdit
     366        Left = 3
     367        Top = 143
     368        Width = 404
     369        Height = 21
     370        MaxLength = 80
     371        TabOrder = 11
    391372        OnChange = OPChange
     373        Caption = 'Special Instructions'
     374      end
     375      object cboOPDelivery: TORComboBox
     376        Left = 292
     377        Top = 86
     378        Width = 120
     379        Height = 21
     380        Style = orcsDropDown
     381        AutoSelect = True
     382        Caption = 'Delivery'
     383        Color = clWindow
     384        DropDownCount = 8
     385        ItemHeight = 13
     386        ItemTipColor = clWindow
     387        ItemTipEnable = True
     388        ListItemsOnly = True
     389        LongList = False
     390        LookupPiece = 0
     391        MaxLength = 0
     392        Pieces = '2'
     393        Sorted = False
     394        SynonymChars = '<>'
     395        TabOrder = 6
     396        OnChange = OPChange
     397        CharsNeedMatch = 1
    392398      end
    393399      object lstOPDietSelect: TORListBox
    394         Left = 127
    395         Top = 52
     400        Left = 0
     401        Top = 53
    396402        Width = 156
    397403        Height = 56
    … …  
    399405        ParentShowHint = False
    400406        ShowHint = True
    401         TabOrder = 2
     407        TabOrder = 1
    402408        Caption = 'Selected Diet Components'
    403409        ItemTipColor = clWindow
    404410        LongList = False
    405411        Pieces = '2'
     412        OnChange = OPChange
    406413      end
    407414      object cmdOPRemove: TButton
    408         Left = 212
    409         Top = 109
     415        Left = 85
     416        Top = 110
    410417        Width = 72
    411418        Height = 17
    412419        Caption = 'Remove'
    413         TabOrder = 3
     420        TabOrder = 2
    414421        OnClick = cmdOPRemoveClick
    415422      end
    … …  
    421428        Caption = 'Cancel Tubefeeding'
    422429        State = cbGrayed
    423         TabOrder = 10
     430        TabOrder = 7
    424431        Visible = False
    425         OnClick = DietChange
     432        OnClick = OPChange
    426433      end
    427434    end
    … …  
    469476        Height = 13
    470477        Caption = 'Amount'
     478      end
     479      object lblOPTFStart: TLabel
     480        Left = 341
     481        Top = 90
     482        Width = 51
     483        Height = 13
     484        Caption = 'Start Date:'
    471485      end
    472486      object cboProduct: TORComboBox
    … …  
    493507        OnExit = cboProductExit
    494508        OnMouseClick = cboProductMouseClick
     509        CharsNeedMatch = 1
    495510      end
    496511      object txtTFComment: TCaptionEdit
    497         Left = 4
     512        Left = 6
    498513        Top = 133
    499514        Width = 504
    500515        Height = 21
    501516        MaxLength = 240
    502         TabOrder = 6
     517        TabOrder = 8
    503518        OnChange = TFChange
    504519        Caption = 'Special Instructions'
    … …  
    542557      object txtQuantity: TCaptionEdit
    543558        Tag = -1
    544         Left = 340
    545         Top = 108
     559        Left = 151
     560        Top = 124
    546561        Width = 93
    547562        Height = 19
    548563        Hint =
    549           'Enter quantity as 2000 K, 100 CC/HOUR, 8 OZ/TID, etc; total quan' +
    550           'tity may not exceed 5000cc.'
     564          'Enter quantity as 2000 K, 100 ML/HOUR, 8 OZ/TID, etc; total quan' +
     565          'tity may not exceed 5000ml.'
    551566        Ctl3D = False
    552567        ParentCtl3D = False
    … …  
    563578      object cboStrength: TCaptionComboBox
    564579        Tag = -1
    565         Left = 444
    566         Top = 108
     580        Left = 252
     581        Top = 124
    567582        Width = 53
    568583        Height = 21
    … …  
    583598          'FULL')
    584599        Caption = 'Strength'
     600      end
     601      object calOPTFStart: TORDateBox
     602        Left = 341
     603        Top = 104
     604        Width = 169
     605        Height = 21
     606        TabStop = False
     607        TabOrder = 7
     608        Visible = False
     609        OnChange = TFChange
     610        DateOnly = False
     611        RequireTime = False
     612        Caption = 'Start Date:'
     613      end
     614      object cboOPTFRecurringMeals: TORComboBox
     615        Left = 342
     616        Top = 105
     617        Width = 160
     618        Height = 21
     619        Style = orcsDropDown
     620        AutoSelect = True
     621        Color = clWindow
     622        DropDownCount = 8
     623        ItemHeight = 13
     624        ItemTipColor = clWindow
     625        ItemTipEnable = True
     626        ListItemsOnly = False
     627        LongList = False
     628        LookupPiece = 0
     629        MaxLength = 0
     630        Pieces = '2,3'
     631        Sorted = False
     632        SynonymChars = '<>'
     633        TabPositions = '12'
     634        TabOrder = 6
     635        TabStop = True
     636        OnChange = TFChange
     637        CharsNeedMatch = 1
    585638      end
    586639    end
    … …  
    705758        Width = 120
    706759        Height = 21
    707         TabOrder = 3
     760        TabOrder = 4
    708761        OnChange = calELStopChange
    709762        DateOnly = True
    … …  
    717770        Height = 152
    718771        Caption = 'Days of Week'
    719         TabOrder = 4
     772        TabOrder = 5
    720773        object chkMonday: TCheckBox
    721774          Left = 8
    … …  
    788841        Height = 17
    789842        Caption = 'Bagged Meal'
    790         TabOrder = 5
     843        TabOrder = 6
    791844        OnClick = ELChange
     845      end
     846      object cboOPELRecurringMeals: TORComboBox
     847        Left = 287
     848        Top = 15
     849        Width = 121
     850        Height = 21
     851        Style = orcsDropDown
     852        AutoSelect = True
     853        Color = clWindow
     854        DropDownCount = 8
     855        ItemHeight = 13
     856        ItemTipColor = clWindow
     857        ItemTipEnable = True
     858        ListItemsOnly = False
     859        LongList = False
     860        LookupPiece = 0
     861        MaxLength = 0
     862        Pieces = '2,3'
     863        Sorted = False
     864        SynonymChars = '<>'
     865        TabPositions = '12'
     866        TabOrder = 3
     867        TabStop = True
     868        OnChange = ELChange
     869        CharsNeedMatch = 1
    792870      end
    793871    end
    … …  
    861939        Caption = 'Enter Additional Diet Order'
    862940      end
     941      object lblOPAOStart: TLabel
     942        Left = 6
     943        Top = 72
     944        Width = 51
     945        Height = 13
     946        Caption = 'Start Date:'
     947      end
    863948      object txtAOComment: TCaptionEdit
    864949        Left = 4
    … …  
    867952        Height = 21
    868953        MaxLength = 80
    869         TabOrder = 0
     954        TabOrder = 1
    870955        OnChange = AOChange
    871956        Caption = 'Enter Additional Diet Order'
    872957      end
     958      object calOPAOStart: TORDateBox
     959        Left = 54
     960        Top = 88
     961        Width = 169
     962        Height = 21
     963        TabStop = False
     964        TabOrder = 4
     965        Visible = False
     966        OnChange = AOChange
     967        DateOnly = False
     968        RequireTime = False
     969        Caption = 'Start Date:'
     970      end
     971      object cboOPAORecurringMeals: TORComboBox
     972        Left = 6
     973        Top = 88
     974        Width = 168
     975        Height = 21
     976        Style = orcsDropDown
     977        AutoSelect = True
     978        Color = clWindow
     979        DropDownCount = 8
     980        ItemHeight = 13
     981        ItemTipColor = clWindow
     982        ItemTipEnable = True
     983        ListItemsOnly = False
     984        LongList = False
     985        LookupPiece = 0
     986        MaxLength = 0
     987        Pieces = '2,3'
     988        Sorted = False
     989        SynonymChars = '<>'
     990        TabPositions = '12'
     991        TabOrder = 2
     992        TabStop = True
     993        OnChange = AOChange
     994        CharsNeedMatch = 1
     995      end
    873996    end
    874997  end
     998  inherited memOrder: TCaptionMemo
     999    Top = 208
     1000  end
    8751001  inherited cmdAccept: TButton
     1002    Left = 445
     1003    Top = 208
    8761004    TabOrder = 2
    8771005  end
    8781006  inherited cmdQuit: TButton
     1007    Left = 445
     1008    Top = 235
    8791009    TabOrder = 3
    8801010  end
    8811011  inherited pnlMessage: TPanel
    882     Top = 172
     1012    Top = 197
    8831013    Height = 57
    8841014    TabOrder = 1

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODDiet.pas

    r459 r460  
    9696    cmdOPRemove: TButton;
    9797    chkOPCancelTubefeeding: TCheckBox;
     98    calOPTFStart: TORDateBox;
     99    lblOPTFStart: TLabel;
     100    lblOPAOStart: TLabel;
     101    calOPAOStart: TORDateBox;
     102    cboOPAORecurringMeals: TORComboBox;
     103    cboOPTFRecurringMeals: TORComboBox;
     104    cboOPELRecurringMeals: TORComboBox;
    98105    procedure nbkDietChanging(Sender: TObject;
    99106      var AllowChange: Boolean);
    … …  
    137144    procedure FormKeyDown(Sender: TObject; var Key: Word;
    138145      Shift: TShiftState);
    139    //  Outpatient meal additions
    140     procedure cboOPDietAvailNeedData(Sender: TObject;
    141       const StartFrom: String; Direction, InsertAt: Integer);
    142146    procedure cboOPDietAvailMouseClick(Sender: TObject);
    143147    procedure cboOPDietAvailExit(Sender: TObject);
    … …  
    149153    procedure grpOPMealClick(Sender: TObject);
    150154    procedure cmdOPRemoveClick(Sender: TObject);
     155    procedure cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
     156      Shift: TShiftState);
    151157  private
    152158    FNextCol: Integer;
    … …  
    177183    function TFStrengthCode(const x: string): Integer;
    178184   //  Outpatient meal additions
     185    function  FMDOW(AnFMDate: TFMDateTime): integer;
     186    function  FMDays(AStart, AEnd: TFMDateTime): string;
    179187    function  GetOPDaysOfWeek: string;
    180     procedure SetEnableOPDOW(AllowUse: Boolean);
     188    procedure SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
    181189    procedure ResetControlsOP;
    182190    procedure SetValuesFromResponsesOP;
    … …  
    184192    procedure OPDietCheckForNPO;
    185193    procedure OPDietCheckForTF;
     194    function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
    186195  protected
    187196    procedure InitDialog; override;
    … …  
    195204  uDialogName: string;
    196205  uFHAUTH: boolean;
     206  uRecurringMealList: TStringList;
    197207
    198208implementation
    … …  
    200210{$R *.DFM}
    201211
    202 uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid;
     212uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid, DateUtils;
    203213
    204214const
    … …  
    209219  TX_DIET_PRC = 'This diet conflicts with ';
    210220  TC_DIET_ERR = 'Unable to Add Diet';
    211   TX_INPT_ONLY = 'Diets may be entered for inpatients only.';
    212   //TX_INPT_ONLY = 'This type of diet may be entered for inpatients only.';
     221  TX_INPT_ONLY = 'This type of diet may be entered for inpatients only.';
    213222  TC_INPT_ONLY = 'Ordering Restriction';
    214223  TX_CANCEL_TF = 'Cancel the current tubefeeding order?' + CRLF + CRLF;
    … …  
    221230  TX_TFQTY  = 'A quantity must be entered for ';
    222231  TX_TFAMT  = 'The quantity is invalid for ';
    223   TX_TF5000 = 'The total quantity ordered may not exceed 5000cc.';
     232  TX_TF5000 = 'The total quantity ordered may not exceed 5000ml.';
    224233  TX_HLPQTY = CRLF + 'The following may be entered for quantity:' + CRLF +
    225               '  Units may be K for Kcals, C for cc''s, O for oz. or U for units (e.g. cans).' + CRLF +
     234              '  Units may be K for Kcals, C for cc''s, M for ml, O for oz. or U for units (e.g. cans).' + CRLF +
    226235              '  Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H.' + CRLF +
    227236              '  May also input 100CC/HR X 16 for 16 hours.  Valid quantity for powder form' + CRLF +
    … …  
    242251  TX_AONONE      = 'Text for additional order has not been entered.';
    243252  TX_ACCEPT      = 'Accept the following order?' + CRLF + CRLF;
     253  TX_CONTINUE    = 'Continue editing the following order?' + CRLF + CRLF;
     254  TX_DISCARD     = CRLF + CRLF + 'Answering NO will discard all changes.';
    244255  TC_ACCEPT      = 'Unsaved Order';
    245256  TX_EL_SAVE_ERR    = 'An error occurred while saving this late tray order.';
    … …  
    274285                    'coordinator enters times for E/L trays for this location.';
    275286  TC_NO_PARAMS    = 'Unable to Order Early/Late Tray';
     287  TX_NOSTART   = 'A valid start date must be entered.';
     288  TC_NOSTART   = 'Start date required';
     289  TX_NOT_THIS_LOC = 'This location has not been configured to' + CRLF +
     290                    'allow ordering of meals for outpatients.' + CRLF + CRLF +
     291                    'Please contact your IRM diet package coordinator.';
     292  TC_NOT_THIS_LOC = 'Unable to order from this location';
     293  TX_NO_OUTPT_ORDERS = 'Diet orders may only be entered for inpatients.';
     294  TC_NO_OUTPT_ORDERS = 'Ordering Restriction';
     295  TX_NO_MEALS_DEFINED = 'No diet types have been defined to be orderable for outpatients.' + CRLF + CRLF +
     296                        'Please contact your IRM diet package coordinator.';
     297  TC_NO_MEALS_DEFINED = 'Unable to order outpatient meals';
     298
     299  FMDayLetters: array[1..7] of string[1] = ('M', 'T', 'W', 'R', 'F', 'S', 'X');
    276300
    277301type
    … …  
    290314begin
    291315  inherited;
     316  AbortOrder := False;
     317  uRecurringMealList := TStringList.Create;
    292318  if OrderForInpatient then
    293319    begin
    … …  
    302328  else                                         // this block will go away after FH patch installed everywhere
    303329    begin
    304       InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
    305       Close;
     330      InfoBox(TX_NO_OUTPT_ORDERS, TC_NO_OUTPT_ORDERS, MB_OK);
     331      AbortOrder := True;
    306332      Exit;
    307333    end;
    … …  
    313339  if StrToIntDef(ALocation, 0) < 1 then
    314340    ALocation := IntToStr(Encounter.Location);
    315   LoadDietParams(uDietParams, ALocation);
    316   if pgeOutPt.TabVisible then
    317     with uDietParams, cboOPDelivery do
    318     begin
    319       if Tray      then Items.Add('T^Tray');
    320       if Cafeteria then Items.Add('C^Cafeteria');
    321       if DiningRm  then Items.Add('D^Dining Room');
    322       //if Bagged    then Items.Add('B^Bagged');  // ????
    323       ItemIndex := 0;
    324       chkBagged.Visible := uDietParams.Bagged;    // ????
     341  if (not OrderForInpatient) and OutpatientPatchInstalled and (not OutpatientLocationConfigured(ALocation)) then
     342    begin
     343      InfoBox(TX_NOT_THIS_LOC, TC_NOT_THIS_LOC, MB_OK or MB_ICONINFORMATION);
     344      AbortOrder := True;
    325345    end
    326346  else
    327     with uDietParams, cboDelivery do
    328     begin
    329       if Tray      then Items.Add('T^Tray');
    330       if Cafeteria then Items.Add('C^Cafeteria');
    331       if DiningRm  then Items.Add('D^Dining Room');
    332       ItemIndex := 0;
    333       chkBagged.Visible := uDietParams.Bagged;
     347    begin
     348      LoadDietParams(uDietParams, ALocation);
     349      if pgeOutPt.TabVisible then
     350        with uDietParams, cboOPDelivery do
     351        begin
     352          if Tray      then Items.Add('T^Tray');
     353          if Cafeteria then Items.Add('C^Cafeteria');
     354          if DiningRm  then Items.Add('D^Dining Room');
     355          ItemIndex := 0;
     356          chkBagged.Visible := uDietParams.Bagged;
     357        end
     358      else
     359        with uDietParams, cboDelivery do
     360        begin
     361          if Tray      then Items.Add('T^Tray');
     362          if Cafeteria then Items.Add('C^Cafeteria');
     363          if DiningRm  then Items.Add('D^Dining Room');
     364          ItemIndex := 0;
     365          chkBagged.Visible := uDietParams.Bagged;
     366        end;
    334367    end;
    335368  TAccessibleStringGrid.WrapControl(grdSelected);
    … …  
    340373  TAccessibleStringGrid.UnwrapControl(grdSelected);
    341374  TFClearGrid;
     375  uRecurringMealList.Free;
    342376  inherited;
    343377end;
    … …  
    350384    ColWidths[1] := Canvas.TextWidth('XFULLX') + GetSystemMetrics(SM_CXVSCROLL);
    351385    ColWidths[2] := Canvas.TextWidth('100 GRAMS/HOUR X 24');
    352     ColWidths[3] := Canvas.TextWidth('55000cc');
     386    ColWidths[3] := Canvas.TextWidth('55000ml');
    353387    ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - 3;
    354388    lblTFStrength.Left := Left + ColWidths[0] + 3;
    … …  
    368402procedure TfrmODDiet.SetupDialog(OrderAction: Integer; const ID: string);
    369403begin
     404  if AbortOrder then exit;
    370405  inherited;
    371406  uDialogName := ExternalName(DialogIEN, 101.41);
    … …  
    396431       end;
    397432  'T': begin
     433         if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
     434         begin
     435           Close;
     436           Exit;
     437         end;
    398438         nbkDiet.ActivePage := pgeTubefeeding;
    399439         nbkDietChange(Self);
    … …  
    401441       end;
    402442  'E': begin
     443         if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
     444         begin
     445           Close;
     446           Exit;
     447         end;
    403448         nbkDiet.ActivePage := pgeEarlyLate;
    404449         nbkDietChange(Self);
    … …  
    411456       end;
    412457  'A': begin
     458         if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
     459         begin
     460           Close;
     461           Exit;
     462         end;
    413463         nbkDiet.ActivePage := pgeAdditional;
    414464         nbkDietChange(Self);
    … …  
    442492        nbkDietChange(Self);
    443493        if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
     494        ActiveControl := cboOPDietAvail;
    444495      end;
    445496  end;
    … …  
    517568    end;
    518569    if Sum > 5000 then SetError(TX_TF5000);
     570    if not OrderForInpatient then
     571      if not calOPTFStart.IsValid      then SetError(TX_BAD_START);
    519572  end;
    520573  if nbkDiet.ActivePage = pgeEarlyLate then
    521574  begin
    522575    if grpMeal.ItemIndex = 3                                   then SetError(TX_ELMEAL);
    523     if GetMealTime = ''                                        then SetError(TX_ELTIME);
    524576    if not calELStart.IsValid                                  then SetError(TX_ELNOSTART);
    525     if not calELStop.IsValid                                   then SetError(TX_ELNOSTOP);
    526577    if calELStart.FMDateTime < FMToday                         then SetError(TX_ELSTARTLT);
    527     if calELStop.FMDateTime < FMToday                          then SetError(TX_ELSTOPLT);
    528     if calELStop.FMDateTime < calELStart.FMDateTime            then SetError(TX_ELSTOPSTART);
    529578    if calELStart.FMDateTime > FMDateTimeOffsetBy(FMToday, 30) then SetError(TX_ELSTART30);
    530     if calELStop.FMDateTime > FMDateTimeOffsetBy(FMToday, 30)  then SetError(TX_ELSTOP30);
     579    if OrderForInpatient then
     580    begin
     581      if GetMealTime = ''                                        then SetError(TX_ELTIME);
     582      if not calELStop.IsValid                                   then SetError(TX_ELNOSTOP);
     583      if calELStop.FMDateTime < FMToday                          then SetError(TX_ELSTOPLT);
     584      if calELStop.FMDateTime < calELStart.FMDateTime            then SetError(TX_ELSTOPSTART);
     585      if calELStop.FMDateTime > FMDateTimeOffsetBy(FMToday, 30)  then SetError(TX_ELSTOP30);
     586    end;
    531587    if grpDOW.Enabled and (GetDaysOfWeek = '')                 then SetError(TX_ELDOW);
    532588    if MealTimePassed                                          then SetError(TX_ELPAST);
    … …  
    539595  begin
    540596    if not ContainsVisibleChar(txtAOComment.Text)              then SetError(TX_AONONE);
    541   end;
    542 { TODO -oRich V. -cOutpatient Meals : Add any required Outpatient Meals validation code here }
     597    if not OrderForInpatient then
     598      if not calOPAOStart.IsValid                              then SetError(TX_BAD_START);
     599  end;
    543600  if nbkDiet.ActivePage = pgeOutPt then
    544601  begin
    … …  
    580637  FTabChanging := True;
    581638  if Length(memOrder.Text) > 0 then
    582     if InfoBox(TX_ACCEPT + memOrder.Text, TC_ACCEPT, MB_YESNO) = ID_YES then
    583     begin
    584       cmdAcceptClick(Self);
    585       AllowChange := AcceptOK;
    586     end else
    587     begin
    588       memOrder.Text := '';
    589       memOrder.Lines.Clear;
    590       Responses.Clear;
     639    begin
     640      if nbkDiet.ActivePage = pgeOutpt then
     641        begin
     642          if InfoBox(TX_CONTINUE + memOrder.Text + TX_DISCARD, TC_ACCEPT, MB_YESNO) = ID_YES then
     643            begin
     644              AllowChange := FALSE;
     645            end else
     646            begin
     647              memOrder.Text := '';
     648              memOrder.Lines.Clear;
     649              Responses.Clear;
     650            end;
     651        end
     652      else
     653        begin
     654          if InfoBox(TX_ACCEPT + memOrder.Text, TC_ACCEPT, MB_YESNO) = ID_YES then
     655            begin
     656              cmdAcceptClick(Self);
     657              AllowChange := AcceptOK;
     658            end else
     659            begin
     660              memOrder.Text := '';
     661              memOrder.Lines.Clear;
     662              Responses.Clear;
     663            end;
     664        end
    591665    end;
    592666  FTabChanging := False;
    … …  
    594668
    595669procedure TfrmODDiet.nbkDietChange(Sender: TObject);
     670var
     671  x, CxMsg: string ;
     672  i: integer;
     673  AStringList: TStringList;
     674const
     675//  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet:' + CRLF + CRLF;
     676  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
     677              'you specify a start date for when the new diet should replace the current' + CRLF +
     678              'diet:' + CRLF + CRLF;
     679  TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
    596680begin
    597681  inherited;
    598682  // much of the logic here can be eliminated if ClearDialogControls starts clearing containers
     683  if AbortOrder then
     684  begin
     685    cmdQuitClick(Self);
     686    exit;
     687  end;
    599688  StatusText('Loading Dialog Definition');
    600689  if Sender <> Self then Responses.Clear;
    … …  
    603692  begin
    604693    AllowQuickOrder := True;
    605     OrderMessage(CurrentDietText);
     694    x := CurrentDietText;
     695    if Piece(x, #13, 1) <> 'Current Diet:  ' then
     696    begin
     697      AStringList := TStringList.Create;
     698      try
     699        AStringList.Text := x;
     700        CxMsg := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
     701                 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
     702        if AStringList.Count > 1 then
     703        begin
     704          CxMsg := CxMsg + CRLF + CRLF +
     705                   TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
     706                   + #9 + Copy(AStringList[1], 22, 99) + CRLF;
     707          if AStringList.Count > 2 then
     708          for i := 2 to AStringList.Count - 1 do
     709            CxMsg := CxMsg + #9 + TrimLeft(AStringList[i]) + CRLF;
     710        end;
     711      finally
     712        AStringList.Free;
     713      end;
     714    end;
     715    if CxMsg <> '' then
     716    begin
     717      if InfoBox(CxMsg + CRLF +
     718                'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = ID_NO then
     719      begin
     720        AbortOrder := True;
     721        cmdQuitClick(Self);
     722        exit;
     723      end;
     724    end;
     725    OrderMessage(x);
    606726    Responses.Dialog := 'FHW1';                            // Diet Order
    607727    DisplayGroup := DisplayGroupForDialog('FHW1');
    … …  
    615735  if nbkDiet.ActivePage = pgeTubefeeding then
    616736  begin
    617 { TODO -oRich V. -cOutpatient Meals : Prompt for which recurring meal(s) to apply this order against }
    618737    if not OrderForInpatient then
    619738    begin
    620       // get list of existing OP recurring meals
    621       // if none, then exit with message
    622       // if some, display and allow selection of multiple dates/times
    623       // set different dialog/display group?
    624     end;
     739      if not PatientHasRecurringMeals(uRecurringMealList) then
     740        begin
     741          Changing := False;
     742          nbkDiet.ActivePage := pgeOutPt;
     743          nbkDietChange(nbkDiet);
     744          Exit;
     745          end
     746        else
     747          cboOPTFRecurringMeals.Items.Assign(uRecurringMealList);
     748    end;
     749    cboOPTFRecurringMeals.Visible := not OrderForInpatient;
     750    calOPTFStart.Visible := False;
     751    lblOPTFStart.Visible := not OrderForInpatient;
    625752    AllowQuickOrder := True;
    626753    if Length(uDietParams.CurTF) > 0
    … …  
    644771  if nbkDiet.ActivePage = pgeEarlyLate then
    645772  begin
    646 { TODO -oRich V. -cOutpatient Meals : Prompt for which recurring meal to apply this order against }
    647773    if not OrderForInpatient then
    648     begin
    649       // get list of existing OP recurring meals
    650       // if none, then exit with message
    651       // if some, display and allow selection of one and only one
    652       // set different dialog/display group?
    653     end
     774      begin
     775        if not PatientHasRecurringMeals(uRecurringMealList) then
     776          begin
     777            Changing := False;
     778            nbkDiet.ActivePage := pgeOutPt;
     779            nbkDietChange(nbkDiet);
     780            Exit;
     781          end
     782        else
     783          cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
     784      end
    654785    else if (StrToIntDef(uDietParams.EarlyIEN, 0) = 0) or (StrToIntDef(uDietParams.LateIEN, 0) = 0) then
    655     begin
    656       InfoBox(TX_NO_PARAMS, TC_NO_PARAMS, MB_ICONERROR or MB_OK);
    657       if pgeEarlyLate <> nil then
    658         nbkDiet.SelectNextPage(False);
    659       Exit;
    660     end;
     786      begin
     787        InfoBox(TX_NO_PARAMS, TC_NO_PARAMS, MB_ICONERROR or MB_OK);
     788        if pgeEarlyLate <> nil then
     789          nbkDiet.SelectNextPage(False);
     790        Changing := False;
     791        Exit;
     792      end;
     793    cboOPELRecurringMeals.Visible := not OrderForInpatient;
     794    cboOPELRecurringMeals.TabStop := not OrderForInpatient;
     795    calELStart.Visible := OrderForInpatient;
     796    calELStart.TabStop := OrderForInpatient;
     797    calELStop.Visible := OrderForInpatient;
     798    lblELStop.Visible := OrderForInpatient;
     799    grpDOW.Visible := OrderForInpatient;
     800    grpDOW.Enabled := OrderForInpatient;
    661801    AllowQuickOrder := False;
    662802    OrderMessage('');
    … …  
    678818  if nbkDiet.ActivePage = pgeAdditional then
    679819  begin
    680 { TODO -oRich V. -cOutpatient Meals : Prompt for which recurring meal(s) to apply this order against }
    681     if not OrderForInpatient then
    682     begin
    683       // get list of existing OP recurring meals
    684       // if none, then exit with message
    685       // if some, display and allow selection of multiple dates/times
    686       // set different dialog/display group?
    687     end;
     820  if not OrderForInpatient then
     821    begin
     822      if not PatientHasRecurringMeals(uRecurringMealList) then
     823        begin
     824          Changing := False;
     825          nbkDiet.ActivePage := pgeOutPt;
     826          nbkDietChange(nbkDiet);
     827          Exit;
     828        end
     829      else
     830        cboOPAORecurringMeals.Items.Assign(uRecurringMealList);
     831    end;
     832    cboOPAORecurringMeals.Visible := not OrderForInpatient;
     833    calOPAOStart.Visible := False;  //not OrderForInpatient;
     834    lblOPAOStart.Visible := not OrderForInpatient;
    688835    AllowQuickOrder := False;
    689836    OrderMessage('');
    … …  
    694841  if nbkDiet.ActivePage = pgeOutPt then
    695842  begin
    696     OrderMessage(CurrentDietText);
     843    x := CurrentDietText;
     844    if Length(Piece(x, #$D, 1)) > Length('Current Diet:  ') then
     845      OrderMessage(x)
     846    else
     847      OrderMessage('');
     848    if (uDialogName <> 'FHW SPECIAL MEAL') and (uDialogName <> 'FHW OP MEAL') then
     849      uDialogName := 'FHW OP MEAL';
    697850    Responses.Dialog := uDialogName;
    698851    DisplayGroup := DisplayGroupForDialog(uDialogName);
    699     if uDialogName = 'FHW OP MEAL' then                          // Recurring meal
    700       begin
    701        AllowQuickOrder := True;
    702        ResetControlsOP;
    703        LoadDietQuickList(cboOPDietAvail.Items, 'MEAL');              // use D.G. short name here
    704        cboOPDietAvail.InsertSeparator;
    705        cboOPDietAvail.InitLongList('');
    706        { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
    707        chkOPCancelTubefeeding.State := cbGrayed;
    708        chkOPCancelTubefeeding.Visible := False;
    709        grpOPMeal.Caption := 'Recurring Meal';
    710        SetEnableOPDOW(False);
    711       end
    712     else if uDialogName = 'FHW SPECIAL MEAL' then                 // Special meal
     852    if uDialogName = 'FHW SPECIAL MEAL' then                 // Special meal
    713853      begin
    714854       AllowQuickOrder := False;
    715855       ResetControlsOP;
    716        cboOPDietAvail.InitLongList('');
     856       cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
    717857       { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
    718858       chkOPCancelTubefeeding.State := cbGrayed;
    … …  
    723863       pgeAdditional.TabVisible := False;
    724864       pgeEarlyLate.TabVisible := False;
    725        cboOPDietAvail.SelectByIEN(uDietParams.RegIEN);
     865       cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
    726866       cboOPDietAvailMouseClick(Self);
     867       Changing := False;
     868      end
     869    else if uDialogName = 'FHW OP MEAL' then                          // Recurring meal
     870      begin
     871       AllowQuickOrder := True;
     872       ResetControlsOP;
     873       LoadDietQuickList(cboOPDietAvail.Items, 'MEAL');              // use D.G. short name here
     874       cboOPDietAvail.InsertSeparator;
     875       cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
     876       cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
     877       { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
     878       chkOPCancelTubefeeding.State := cbGrayed;
     879       chkOPCancelTubefeeding.Visible := False;
     880       grpOPMeal.Caption := 'Recurring Meal';
     881       SetEnableOPDOW(False, -1);
     882       cboOPDietAvailMouseClick(Self);
     883       Changing := False;
    727884      end;
    728885  end;
    … …  
    802959          InfoBox(Piece(ADiet,'^',2), TC_DIET_ERR, MB_OK);
    803960          cboDietAvail.ItemIndex := -1;
     961          Changing := False;
    804962          Exit;
    805963        end;
    … …  
    9351093  TFClearGrid;
    9361094  chkCancelTrays.Checked := False;
     1095  calOPTFStart.Text := '';
    9371096  txtTFComment.Text := '';
    9381097end;
    … …  
    9731132    AResponse := FindResponseByName('CANCEL', 1);
    9741133    if AResponse <> nil then chkCancelTrays.Checked := AResponse.IValue = '1';
     1134    if not OrderForInpatient then
     1135    begin
     1136      SetControl(cboOPTFRecurringMeals, 'DATETIME', 1);
     1137      SetControl(calOPTFStart, 'DATETIME', 1);
     1138    end;
    9751139    SetControl(txtTFComment, 'COMMENT',  1);
    9761140  end;
    … …  
    11141278    begin
    11151279      grdSelected.Cells[2, ARow] := Piece(x, U, 2);
    1116       grdSelected.Cells[3, ARow] := Piece(x, U, 1) + 'cc';
     1280      grdSelected.Cells[3, ARow] := Piece(x, U, 1) + 'ml';
    11171281    end
    11181282    else grdSelected.Cells[3, ARow] := '';
    … …  
    12681432    then Responses.Update('CANCEL', 1, '1', 'Yes')
    12691433    else Responses.Update('CANCEL', 1, '0', 'No');
     1434  if not OrderForInpatient then
     1435  begin
     1436    calOPTFStart.FMDateTime := StrToFloatDef(cboOPTFRecurringMeals.ItemID, 0);
     1437    Responses.Update('DATETIME', 1, FloatToStr(calOPTFStart.FMDateTime), calOPTFStart.Text);
     1438  end;
    12701439  memOrder.Text := Responses.OrderText;
    12711440end;
    … …  
    13231492      if radLT3.Caption = AResponse.IValue then radLT3.Checked := True;
    13241493    end;
    1325     SetControl(calELStart, 'START', 1);
    1326     SetControl(calELStop,  'STOP',  1);
     1494    if not OrderForInpatient then
     1495      SetControl(cboOPELRecurringMeals, 'START', 1)
     1496    else
     1497    begin
     1498      SetControl(calELStart, 'START', 1);
     1499      SetControl(calELStop,  'STOP',  1);
     1500    end;
    13271501    calELStopChange(Self);
    13281502    AResponse := FindResponseByName('SCHEDULE', 1);
    … …  
    14031577    lblNoTimes.Visible := not HasTimes;
    14041578  end;
    1405 
    1406 begin
    1407   inherited;
     1579var
     1580  AMeal: string;
     1581begin
     1582  inherited;
     1583  Changing := True;
    14081584  case grpMeal.ItemIndex of
    1409     0: SetMealTimes(uDietParams.BTimes);
    1410     1: SetMealTimes(uDietParams.NTimes);
    1411     2: SetMealTimes(uDietParams.ETimes);
    1412   else SetMealTimes('');
    1413   end;
     1585    0: begin
     1586         SetMealTimes(uDietParams.BTimes);
     1587         AMeal := 'B';
     1588       end;
     1589    1: begin
     1590         SetMealTimes(uDietParams.NTimes);
     1591         AMeal := 'N';
     1592       end;
     1593    2: begin
     1594         SetMealTimes(uDietParams.ETimes);
     1595         AMeal := 'E';
     1596       end;
     1597  else
     1598    begin
     1599      SetMealTimes('');
     1600      AMeal := '';
     1601    end;
     1602  end;
     1603  if not OrderForInpatient then
     1604    begin
     1605      if AMeal = '' then
     1606      begin
     1607        uRecurringMealList.Clear;
     1608        cboOPELRecurringMeals.Clear;
     1609      end
     1610      else if not PatientHasRecurringMeals(uRecurringMealList, AMeal) then
     1611        begin
     1612          uRecurringMealList.Clear;
     1613          cboOPELRecurringMeals.Clear;
     1614          grpMeal.ItemIndex := 3;
     1615        end
     1616      else
     1617        cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
     1618    end;
     1619  Changing := False;
     1620  ELChange(grpMeal);
    14141621end;
    14151622
    … …  
    14451652begin
    14461653  inherited;
    1447   if (Length(calELStop.Text) > 0) and (calELStop.Text = calELStart.Text)
     1654  if not OrderForInpatient then SetEnableDOW(False)
     1655  else if (Length(calELStop.Text) > 0) and (calELStop.Text = calELStart.Text)
    14481656    then SetEnableDOW(False)
    14491657    else SetEnableDOW(True);
    … …  
    14781686      then Responses.Update('ORDERABLE', 1, uDietParams.EarlyIEN, 'EARLY TRAY')
    14791687      else Responses.Update('ORDERABLE', 1, uDietParams.LateIEN,  'LATE TRAY');
     1688  end;
     1689  if not OrderForInpatient then
     1690  begin
     1691    calELStart.FMDateTime := StrToFloatDef(cboOPELRecurringMeals.ItemID, 0);
     1692    calELStop.FMDateTime := calELStart.FMDateTime;
    14801693  end;
    14811694  with calELStart   do if Length(Text) > 0 then Responses.Update('START',     1, Text,   Text);
    … …  
    15251738begin
    15261739  txtAOComment.Text := '';
     1740  calOPAOStart.Text := '';
    15271741end;
    15281742
    … …  
    15321746  ResetControlsAO;
    15331747  Responses.SetControl(txtAOComment, 'COMMENT', 1);
     1748  //Responses.SetControl(calOPAOStart, 'DATETIME', 1);
     1749  Responses.SetControl(cboOPAORecurringMeals, 'DATETIME', 1);
    15341750  Changing := False;
    15351751  AOChange(Self);
    … …  
    15421758  with txtAOComment do if Text <> ''
    15431759    then Responses.Update('COMMENT', 1, Text, Text);
     1760  if not OrderForInpatient then
     1761    begin
     1762      calOPAOStart.FMDateTime := StrToFloatDef(cboOPAORecurringMeals.ItemID, 0);
     1763      Responses.Update('DATETIME', 1, FloatToStr(calOPAOStart.FMDateTime), calOPAOStart.Text);
     1764    end;
    15441765  memOrder.Text := Responses.OrderText;
    15451766end;
    15461767
     1768
    15471769{ Outpatient Meals Order tab ----------------------------------------------------------------- }
    1548 
    1549 procedure TfrmODDiet.cboOPDietAvailNeedData(Sender: TObject; const StartFrom: string;
    1550   Direction, InsertAt: Integer);
    1551 begin
    1552   inherited;
    1553   cboOPDietAvail.ForDataUse(SubsetOfOPDiets(StartFrom, Direction));
    1554 end;
    15551770
    15561771procedure TfrmODDiet.cboOPDietAvailMouseClick(Sender: TObject);
    … …  
    15661781begin
    15671782  inherited;
     1783  if cboOPDietAvail.Items.Count = 0 then
     1784    begin
     1785      InfoBox(TX_NO_MEALS_DEFINED, TC_NO_MEALS_DEFINED, MB_OK or MB_ICONINFORMATION);
     1786      AbortOrder := True;
     1787      exit;
     1788    end  ;
    15681789  if CharAt(cboOPDietAvail.ItemID, 1) = 'Q' then              // setup quick order
    15691790  begin
    … …  
    15921813    OPChange(Sender);
    15931814  end; {if cboOPDietAvail}
     1815  OPChange(Sender);
    15941816  cboOPDietAvail.ItemIndex := -1;
    1595   OPChange(Sender);
    15961817end;
    15971818
    … …  
    16431864procedure TfrmODDiet.SetValuesFromResponsesOP;
    16441865var
    1645   //AnInstance: Integer;
    16461866  AResponse: TResponse;
    16471867  ADiet: string;
    … …  
    16511871  with Responses do
    16521872  begin
    1653 (*    AnInstance := NextInstance('ORDERABLE', 0);
    1654     while AnInstance > 0 do
    1655     begin
    1656       AResponse := FindResponseByName('ORDERABLE', AnInstance);
    1657       if AResponse <> nil then
    1658       begin
    1659         ADiet := DietAttributes(StrToIntDef(AResponse.IValue,0));
    1660         if Piece(ADiet,'^',1)='0' then
    1661         begin
    1662           InfoBox(Piece(ADiet,'^',2), TC_OP_DIET_ERR, MB_OK);
    1663           cboOPDietAvail.ItemIndex := -1;
    1664           Exit;
    1665         end;
    1666         lstOPDietSelect.Items.Add(ADiet);
    1667       end;
    1668       AnInstance := NextInstance('ORDERABLE', AnInstance);
    1669     end; {while AnInstance - ORDERABLE}*)
    1670 
    16711873    AResponse := FindResponseByName('ORDERABLE', 1);
    16721874    if AResponse <> nil then
    … …  
    16771879        InfoBox(Piece(ADiet,'^',2), TC_OP_DIET_ERR, MB_OK);
    16781880        cboOPDietAvail.ItemIndex := -1;
     1881        Changing := False;
    16791882        Exit;
    16801883      end;
    … …  
    17211924begin
    17221925  inherited;
     1926  if Changing then exit;
    17231927  if FChangeStop then
    17241928    calOPStop.Text := calOPStart.Text
    … …  
    17271931end;
    17281932
     1933function TfrmODDiet.FMDOW(AnFMDate: TFMDateTime): integer;
     1934var
     1935  WinDate: TDateTime;
     1936  x: integer;
     1937begin
     1938  WinDate := FMDateTimeToDateTime(AnFMDate);
     1939  x := DayOfTheWeek(WinDate);
     1940  Result := x;
     1941end;
     1942
     1943function TfrmODDiet.FMDays(AStart, AEnd: TFMDateTime): string;
     1944var
     1945  AWinStart, AWinEnd: TDateTime;
     1946  i: double;
     1947  Days: string;
     1948begin
     1949  AWinStart := FMDateTimeToDateTime(AStart);
     1950  AWinEnd := FMDateTimeToDateTime(AEnd);
     1951  i := AWinStart;
     1952  repeat
     1953    Days := Days + FMDayLetters[DayOfTheWeek(i)];
     1954    i := i + 1;
     1955  until i > AWinEnd;
     1956  Result := Days;
     1957end;
     1958
    17291959procedure TfrmODDiet.calOPStartExit(Sender: TObject);
    1730 begin
    1731   inherited;
    1732   if (Length(calOPStop.Text) > 0) and (calOPStop.Text = calOPStart.Text)
    1733     then SetEnableOPDOW(False)
    1734     else SetEnableOPDOW(True);
     1960var
     1961  Days: string;
     1962begin
     1963  inherited;
     1964  if not (calOPStart.FMDateTime > 0) then
     1965  begin
     1966    SetEnableOPDOW(False, -1);
     1967    Exit ;
     1968  end;
     1969  if (Length(calOPStop.Text) > 0) and (calOPStop.Text = calOPStart.Text) then
     1970    SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
     1971  else
     1972  begin
     1973    Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
     1974    SetEnableOPDOW(True, -1, Days);
     1975  end;
    17351976end;
    17361977
    17371978procedure TfrmODDiet.calOPStopChange(Sender: TObject);
    1738 begin
    1739   inherited;
    1740   if (Length(calOPStop.Text) > 0) and (calOPStop.FMDateTime = calOPStart.FMDateTime)
    1741     then SetEnableOPDOW(False)
    1742     else SetEnableOPDOW(True);
     1979var
     1980  Days: string;
     1981begin
     1982  inherited;
     1983  if Changing then exit;
     1984  if not (calOPStop.FMDateTime > 0) then
     1985  begin
     1986    SetEnableOPDOW(False, -1);
     1987    Exit ;
     1988  end;
     1989  if (Length(calOPStop.Text) > 0) and (calOPStop.FMDateTime = calOPStart.FMDateTime) then
     1990    SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
     1991  else
     1992  begin
     1993    Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
     1994    SetEnableOPDOW(True, -1, Days);
     1995  end;
    17431996  OPChange(Sender);
    17441997end;
    … …  
    17522005  if Changing then Exit;
    17532006  if Sender <> Self then Responses.Clear;       // Sender=Self when called from SetupDialog
    1754   // Per NFS, only one selection allowed from any of 5 available OP diets
     2007  // Per NFS, only one selection allowed from any of 10-15 available OP diets
    17552008  with lstOPDietSelect do if Items.Count > 0 then
    17562009    Responses.Update('ORDERABLE', 1, Piece(Items[0], U, 1), Piece(Items[0], U, 2));
    … …  
    17652018    begin
    17662019      x := GetOPDaysOfWeek;
    1767       if Length(x) > 0 then Responses.Update('SCHEDULE', 1, x, x);
     2020      if Length(x) = 0 then x := 'ONCE';
     2021      Responses.Update('SCHEDULE', 1, x, x);
    17682022    end;
    17692023  with txtOPDietComment do {if Length(Text) > 0 then} Responses.Update('COMMENT',   1, Text,   Text);
    … …  
    17842038end;
    17852039
    1786 procedure TfrmODDiet.SetEnableOPDOW(AllowUse: Boolean);
    1787 begin
     2040procedure TfrmODDiet.SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
     2041var
     2042  i: integer;
     2043begin
     2044  if (not AllowUse) and (OneTimeDay > -1) then
     2045    begin
     2046      for i := 0 to grpOPDOW.ControlCount - 1 do
     2047      begin
     2048        if grpOPDOW.Controls[i] is TCheckBox then
     2049          TCheckBox(grpOPDOW.Controls[i]).Checked := False;
     2050      end;
     2051      //TCheckBox(grpOPDOW.Controls[OneTimeDay - 1]).Checked := True;  CQ #8305
     2052    end;
    17882053  grpOPDOW.Enabled       := AllowUse;
    1789   chkOPMonday.Enabled    := AllowUse;
    1790   chkOPTuesday.Enabled   := AllowUse;
    1791   chkOPWednesday.Enabled := AllowUse;
    1792   chkOPThursday.Enabled  := AllowUse;
    1793   chkOPFriday.Enabled    := AllowUse;
    1794   chkOPSaturday.Enabled  := AllowUse;
    1795   chkOPSunday.Enabled    := AllowUse;
     2054  chkOPMonday.Enabled    := AllowUse and (Pos('M', DaysToCheck) > 0);
     2055  chkOPTuesday.Enabled   := AllowUse and (Pos('T', DaysToCheck) > 0);
     2056  chkOPWednesday.Enabled := AllowUse and (Pos('W', DaysToCheck) > 0);
     2057  chkOPThursday.Enabled  := AllowUse and (Pos('R', DaysToCheck) > 0);
     2058  chkOPFriday.Enabled    := AllowUse and (Pos('F', DaysToCheck) > 0);
     2059  chkOPSaturday.Enabled  := AllowUse and (Pos('S', DaysToCheck) > 0);
     2060  chkOPSunday.Enabled    := AllowUse and (Pos('X', DaysToCheck) > 0);
    17962061end;
    17972062
    … …  
    18962161    // check if late tray should be ordered
    18972162    AResponse := Responses.FindResponseByName('ORDERABLE', 1);
    1898     if (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
     2163    if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
    18992164    begin
    19002165      AResponse := Responses.FindResponseByName('START', 1);
    … …  
    19152180    // check if late tray should be ordered
    19162181    AResponse := Responses.FindResponseByName('ORDERABLE', 1);
    1917     if (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
     2182    if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
    19182183    begin
    19192184      AResponse := Responses.FindResponseByName('START', 1);
    … …  
    19302195    if NewOrder.ID <> '' then
    19312196    begin
    1932       if (Encounter.Provider = User.DUZ) and User.CanSignOrders
    1933         then CanSign := CH_SIGN_YES
    1934         else CanSign := CH_SIGN_NA;
     2197      if OrderForInpatient then
     2198        begin
     2199          if (Encounter.Provider = User.DUZ) and User.CanSignOrders
     2200            then CanSign := CH_SIGN_YES
     2201            else CanSign := CH_SIGN_NA;
     2202        end
     2203      else
     2204        begin
     2205          CanSign := CH_SIGN_NA;
     2206        end;
    19352207      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
    19362208      SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
    … …  
    19552227end;
    19562228
     2229procedure TfrmODDiet.cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
     2230  Shift: TShiftState);
     2231begin
     2232  inherited;
     2233  if Key = VK_RETURN then cboOPDietAvailMouseClick(Self);
     2234end;
     2235
     2236function TfrmODDiet.PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
     2237const
     2238  TX_NO_RECURRING_MEALS = 'For outpatients, this type of order requires association with an existing recurring' + CRLF +
     2239                          'meal order.  There are currently no active recurring meal orders for this patient.' + CRLF + CRLF +
     2240                          'Those orders must be signed and released before they can be linked to this item.';
     2241  TC_NO_RECURRING_MEALS = 'Unable to order ' ;
     2242begin
     2243  MealList.Clear;
     2244  GetCurrentRecurringOPMeals(MealList, MealType);
     2245  if MealList.Count = 0 then
     2246    begin
     2247      InfoBox(TX_NO_RECURRING_MEALS, TC_NO_RECURRING_MEALS + nbkDiet.ActivePage.Caption, MB_OK);
     2248      Result := False;
     2249    end
     2250  else
     2251    Result := True;
     2252end;
     2253
    19572254end.
    19582255

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODDietLT.pas

    r459 r460  
    7575  begin
    7676    TimePart := Frac(x);
    77     if TimePart > 0.12 then
     77    if TimePart > 0.1159 then
    7878    begin
    79       x := x - 0.12;
     79      if TimePart > 0.1259 then x := x - 0.12;
    8080      Suffix := 'P'
    8181    end
    … …  
    127127       (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := 'E';
    128128    if Meal = #0 then Exit;
    129     // get the available late times for this meal
    130     case Meal of
    131     'B': AvailTimes := Pieces(DietParams.BTimes, U, 4, 6);
    132     'E': AvailTimes := Pieces(DietParams.ETimes, U, 4, 6);
    133     'N': AvailTimes := Pieces(DietParams.NTimes, U, 4, 6);
    134     end;
    135     SetAvailTimes(TimePart, TimeCount, AvailTimes);
    136     if TimeCount = 0 then Exit;
    137129  end
    138130  else  // for outpatients
    139131  begin
     132(*  From Rich Knoepfle, NFS developer
     133If they order a breakfast and it is after the LATE BREAKFAST ALARM END, I don't allow them to do it.  (For special meals I don't allow them to order something for the following day).
     134If it's before the LATE BREAKFAST ALARM BEGIN than I accept the order.
     135If it's between the LATE BREAKFAST ALARM BEGIN and ALARM END then I ask if they want to order a Late breakfast tray.
     136*)
    140137    Meal := AMeal;
    141138    case AMeal of
    142       'B':  if TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000) then Meal := #0;
    143       'N':  if TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000) then Meal := #0;
    144       'E':  if TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000) then Meal := #0;
     139      'B':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) or
     140               (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := #0;
     141      'N':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) or
     142               (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := #0;
     143      'E':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) or
     144               (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := #0;
    145145    end;
    146146    if Meal = #0 then exit;
    147147  end;
     148
     149  // get the available late times for this meal
     150  case Meal of
     151  'B': AvailTimes := Pieces(DietParams.BTimes, U, 4, 6);
     152  'E': AvailTimes := Pieces(DietParams.ETimes, U, 4, 6);
     153  'N': AvailTimes := Pieces(DietParams.NTimes, U, 4, 6);
     154  end;
     155  SetAvailTimes(TimePart, TimeCount, AvailTimes);
     156  if TimeCount = 0 then Exit;
     157
    148158  // setup form to get the selected late tray
    149159  frmODDietLT := TfrmODDietLT.Create(Application);
    … …  
    153163    begin
    154164      FOutpatient := IsOutpatient;
    155       if not IsOutpatient then
    156       begin
    157         if Length(Piece(AvailTimes, U, 1)) > 0 then radLT1.Caption := Piece(AvailTimes, U, 1);
    158         if Length(Piece(AvailTimes, U, 2)) > 0 then radLT2.Caption := Piece(AvailTimes, U, 2);
    159         if Length(Piece(AvailTimes, U, 3)) > 0 then radLT3.Caption := Piece(AvailTimes, U, 3);
    160         radLT1.Visible := Length(radLT1.Caption) > 0;
    161         radLT2.Visible := Length(radLT2.Caption) > 0;
    162         radLT3.Visible := Length(radLT3.Caption) > 0;
    163         radLT1.Checked := TimeCount = 1;
    164       end
    165       else GroupBox1.Visible := False;
     165      if Length(Piece(AvailTimes, U, 1)) > 0 then radLT1.Caption := Piece(AvailTimes, U, 1);
     166      if Length(Piece(AvailTimes, U, 2)) > 0 then radLT2.Caption := Piece(AvailTimes, U, 2);
     167      if Length(Piece(AvailTimes, U, 3)) > 0 then radLT3.Caption := Piece(AvailTimes, U, 3);
     168      radLT1.Visible := Length(radLT1.Caption) > 0;
     169      radLT2.Visible := Length(radLT2.Caption) > 0;
     170      radLT3.Visible := Length(radLT3.Caption) > 0;
     171      radLT1.Checked := TimeCount = 1;
    166172      chkBagged.Visible := DietParams.Bagged;
    167173      with lblMealCutOff do case Meal of
    … …  
    174180      if YesPressed then
    175181      begin
    176         if not IsOutpatient then
    177         begin
    178           with radLT1 do if Checked then LateTrayFields.LateTime := Caption;
    179           with radLT2 do if Checked then LateTrayFields.LateTime := Caption;
    180           with radLT3 do if Checked then LateTrayFields.LateTime := Caption;
    181         end
    182         else
    183           LateTrayFields.LateTime := FMTimeToAMPM(FMToday + TimePart);
     182        with radLT1 do if Checked then LateTrayFields.LateTime := Caption;
     183        with radLT2 do if Checked then LateTrayFields.LateTime := Caption;
     184        with radLT3 do if Checked then LateTrayFields.LateTime := Caption;
    184185        LateTrayFields.LateMeal := Meal;
    185186        LateTrayFields.IsBagged := chkBagged.Checked;
    186       end; {if YesPressed}
     187      end;
    187188    end; {with frmODDietLT}
    188189  finally

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODGen.pas

    r459 r460  
    339339    Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
    340340    TORDateBox(Editor).DateOnly := Pos('T', DialogItem.Domain) = 0;
     341    with TORDateBox(Editor) do RequireTime := (not DateOnly) and (Pos('R', DialogItem.Domain) > 0); //v26.48 - RV  PSI-05-002
    341342    TORDateBox(Editor).Text := DialogItem.EDefault;
    342343    TORDateBox(Editor).Hint := DialogItem.HelpText;
    … …  
    490491        end;
    491492        with TORComboBox(Editor) do
     493        begin
    492494          Items.AddStrings(TStrings(TopTSList));
     495          LongList := false;
     496        end;
    493497      end else
    494498        TORComboBox(Editor).OnNeedData := LookupNeedData;

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODLab.dfm

    r459 r460  
    374374    OnExit = cboAvailTestExit
    375375    OnNeedData = cboAvailTestNeedData
     376    CharsNeedMatch = 1
    376377  end
    377378  object cboFrequency: TORComboBox
    … …  
    397398    TabOrder = 16
    398399    OnChange = cboFrequencyChange
     400    CharsNeedMatch = 1
    399401  end
    400402  object cboCollSamp: TORComboBox
    … …  
    423425    OnKeyPause = cboCollSampKeyPause
    424426    OnMouseClick = cboCollSampMouseClick
     427    CharsNeedMatch = 1
    425428  end
    426429  object cboSpecimen: TORComboBox
    … …  
    451454    OnKeyPause = cboSpecimenKeyPause
    452455    OnMouseClick = cboSpecimenMouseClick
     456    CharsNeedMatch = 1
    453457  end
    454458  object cboUrgency: TORComboBox
    … …  
    474478    TabOrder = 3
    475479    OnChange = cboUrgencyChange
     480    CharsNeedMatch = 1
    476481  end
    477482  object txtAddlComment: TCaptionEdit
    … …  
    533538    OnChange = cboCollTimeChange
    534539    OnExit = cboCollTimeExit
     540    CharsNeedMatch = 1
    535541  end
    536542  object cboCollType: TORComboBox
    … …  
    556562    TabOrder = 11
    557563    OnChange = cboCollTypeChange
     564    CharsNeedMatch = 1
    558565  end
    559566  object dlgLabCollTime: TORDateTimeDlg

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODLab.pas

    r459 r460  
    181181
    182182uses rODBase, rODLab, uCore, rCore, fODLabOthCollSamp, fODLabOthSpec, fODLabImmedColl, fLabCollTimes,
    183  rOrders, uODBase, fRptBox;
     183 rOrders, uODBase, fRptBox, fFrame;
    184184
    185185
    … …  
    208208  AList: TStringList;
    209209begin
     210  frmFrame.pnlVisit.Enabled := false;
    210211  AutoSizeDisabled := True;
    211212  inherited;
    … …  
    417418      TestID := StrToInt(LabTestIEN);
    418419      TestName := Piece(ExtractDefault(LoadData, 'Test Name'),U,1);
    419       LabSubscript := Piece(ExtractDefault(LoadData, 'Test Name'),U,2);
     420      LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
    420421      TestReqComment := ExtractDefault(LoadData, 'ReqCom');
    421422      if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
    … …  
    826827
    827828procedure TfrmODLab.ControlChange(Sender: TObject);
     829var
     830  AResponse: TResponse;
     831  AVisitStr: string;
    828832begin
    829833  inherited;
    830834  if Changing or (ALabTest = nil) then Exit;
     835  AResponse := Responses.FindResponseByName('VISITSTR', 1);
     836  if AResponse <> nil then
     837    AVisitStr := AResponse.EValue;
    831838  Responses.Clear;
    832839  with ALabTest do
    … …  
    877884  with txtDays do if Enabled then Responses.Update('DAYS', 1, Text, Text);
    878885  { worry about stop date later }
     886  if AVisitStr <> '' then Responses.Update('VISITSTR', 1, AVisitStr, AVisitStr);
    879887  memOrder.Text := Responses.OrderText;
    880888end;
    … …  
    15271535  inherited;
    15281536  if FCmtTypes <> nil then FCmtTypes.Free;
     1537  frmFrame.pnlVisit.Enabled := true;
    15291538end;
    15301539

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedFA.dfm

    r459 r460  
    55  Height = 205
    66  Caption = 'Formulary Alternatives'
     7  FormStyle = fsStayOnTop
    78  OnCreate = FormCreate
    89  PixelsPerInch = 96

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedIV.dfm

    r459 r460  
    11inherited frmODMedIV: TfrmODMedIV
    2   Left = 321
    3   Top = 199
     2  Left = 587
     3  Top = 331
    44  Width = 610
    55  Height = 341
    6   Caption = 'IV Fluid Order'
     6  Caption = 'Infusion Order'
    77  OnKeyDown = FormKeyDown
    88  PixelsPerInch = 96
    … …  
    1111    Left = 6
    1212    Top = 196
    13     Width = 63
    14     Height = 13
    15     Caption = 'Infusion Rate'
     13    Width = 96
     14    Height = 13
     15    Caption = 'Infusion Rate (ml/hr)'
    1616  end
    1717  object lblPriority: TLabel [1]
    … …  
    3030  end
    3131  object lblAmount: TLabel [3]
    32     Left = 333
     32    Left = 328
    3333    Top = 6
    34     Width = 74
    35     Height = 13
    36     Caption = 'Volume/Strenth'
     34    Width = 80
     35    Height = 13
     36    Caption = 'Volume/Strength'
    3737    WordWrap = True
    3838  end
    … …  
    5151    Caption = 'Duration or Total Volume'
    5252  end
    53   object Label1: TStaticText [6]
    54     Left = 100
    55     Top = 213
    56     Width = 28
    57     Height = 17
    58     Caption = 'ml/hr'
    59     TabOrder = 15
    60   end
    61   object cboAdditive: TORComboBox [7]
    62     Left = 6
    63     Top = 20
    64     Width = 200
    65     Height = 125
    66     Style = orcsSimple
    67     AutoSelect = True
    68     Caption = 'Additives'
    69     Color = clWindow
    70     DropDownCount = 11
    71     ItemHeight = 13
    72     ItemTipColor = clWindow
    73     ItemTipEnable = True
    74     ListItemsOnly = True
    75     LongList = True
    76     LookupPiece = 0
    77     MaxLength = 0
    78     Pieces = '2'
    79     Sorted = False
    80     SynonymChars = '<>'
    81     TabPositions = '20'
    82     TabOrder = 0
    83     OnExit = cboAdditiveExit
    84     OnMouseClick = cboAdditiveMouseClick
    85     OnNeedData = cboAdditiveNeedData
    86     CharsNeedMatch = 1
    87   end
    88   object tabFluid: TTabControl [8]
    89     Left = 7
    90     Top = 3
    91     Width = 200
    92     Height = 21
    93     TabHeight = 15
    94     TabOrder = 13
    95     Tabs.Strings = (
    96       '   Solutions   '
    97       '   Additives   ')
    98     TabIndex = 0
    99     TabStop = False
    100     OnChange = tabFluidChange
    101   end
    102   inherited memOrder: TCaptionMemo
    103     Top = 255
    104     Width = 475
    105     TabOrder = 11
    106   end
    107   object txtRate: TCaptionEdit [10]
     53  object txtRate: TCaptionEdit [6]
    10854    Left = 6
    10955    Top = 210
    … …  
    11157    Height = 21
    11258    AutoSelect = False
    113     TabOrder = 6
     59    TabOrder = 5
    11460    OnChange = ControlChange
     61    OnExit = txtRateExit
    11562    Caption = 'Infusion Rate'
    11663  end
    117   object cboPriority: TORComboBox [11]
     64  object cboPriority: TORComboBox [7]
    11865    Left = 134
    11966    Top = 210
    … …  
    13582    Sorted = False
    13683    SynonymChars = '<>'
    137     TabOrder = 7
     84    TabOrder = 6
    13885    OnChange = ControlChange
    13986    CharsNeedMatch = 1
    14087  end
    141   object grdSelected: TCaptionStringGrid [12]
     88  object grdSelected: TCaptionStringGrid [8]
    14289    Left = 214
    14390    Top = 20
    … …  
    15299    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected]
    153100    ScrollBars = ssVertical
    154     TabOrder = 3
     101    TabOrder = 2
    155102    OnDrawCell = grdSelectedDrawCell
    156103    OnKeyPress = grdSelectedKeyPress
    … …  
    158105    Caption = 'Selected Solution and Additives'
    159106  end
    160   object cmdRemove: TButton [13]
     107  object cmdRemove: TButton [9]
    161108    Left = 443
    162109    Top = 99
    … …  
    164111    Height = 18
    165112    Caption = 'Remove'
    166     TabOrder = 4
     113    TabOrder = 3
    167114    OnClick = cmdRemoveClick
    168115  end
    169   object memComments: TCaptionMemo [14]
     116  object memComments: TCaptionMemo [10]
    170117    Left = 214
    171118    Top = 120
    … …  
    175122      'memComments')
    176123    ScrollBars = ssVertical
    177     TabOrder = 5
     124    TabOrder = 4
    178125    OnChange = ControlChange
    179126    Caption = 'Comments'
    180127  end
    181   object txtSelected: TCaptionEdit [15]
     128  object txtSelected: TCaptionEdit [11]
    182129    Tag = -1
    183130    Left = 416
    … …  
    187134    Ctl3D = False
    188135    ParentCtl3D = False
    189     TabOrder = 1
     136    TabOrder = 0
    190137    Text = 'meq.'
    191138    Visible = False
    … …  
    194141    Caption = 'Volume'
    195142  end
    196   object cboSelected: TCaptionComboBox [16]
     143  object cboSelected: TCaptionComboBox [12]
    197144    Tag = -1
    198145    Left = 460
    … …  
    204151    ItemHeight = 13
    205152    ParentCtl3D = False
    206     TabOrder = 2
     153    TabOrder = 1
    207154    Visible = False
    208155    OnChange = cboSelectedChange
    … …  
    210157    Caption = 'Volume/Strength'
    211158  end
     159  inherited memOrder: TCaptionMemo
     160    Top = 255
     161    Width = 475
     162    TabOrder = 10
     163  end
    212164  inherited cmdAccept: TButton
    213165    Left = 495
    214166    Top = 255
    215     TabOrder = 9
     167    TabOrder = 8
    216168  end
    217169  inherited cmdQuit: TButton
    218170    Left = 495
    219171    Top = 282
    220     TabOrder = 10
     172    TabOrder = 9
    221173  end
    222174  inherited pnlMessage: TPanel
    223175    Top = 237
    224     TabOrder = 12
    225   end
    226   object cboSolution: TORComboBox
    227     Left = 6
    228     Top = 19
    229     Width = 200
    230     Height = 164
    231     Style = orcsSimple
    232     AutoSelect = True
    233     Caption = 'Solutions'
    234     Color = clWindow
    235     DropDownCount = 11
    236     ItemHeight = 13
    237     ItemTipColor = clWindow
    238     ItemTipEnable = True
    239     ListItemsOnly = True
    240     LongList = True
    241     LookupPiece = 0
    242     MaxLength = 0
    243     Pieces = '2'
    244     Sorted = False
    245     SynonymChars = '<>'
    246     TabPositions = '20'
    247     TabOrder = 14
    248     OnExit = cboSolutionExit
    249     OnMouseClick = cboSolutionMouseClick
    250     OnNeedData = cboSolutionNeedData
    251     CharsNeedMatch = 1
     176    TabOrder = 11
    252177  end
    253178  object pnlXDuration: TPanel
    … …  
    257182    Height = 21
    258183    BevelOuter = bvNone
    259     TabOrder = 8
     184    TabOrder = 7
    260185    OnEnter = pnlXDurationEnter
    261186    DesignSize = (
    262187      121
    263188      21)
    264     object btnXDuration: TSpeedButton
     189    object btnXDuration: TBitBtn
    265190      Left = 69
    266191      Top = 1
    … …  
    269194      Anchors = [akLeft, akTop, akRight, akBottom]
    270195      Caption = 'days'
     196      TabOrder = 1
     197      OnClick = btnXDurationClick
    271198      Glyph.Data = {
    272199        AE000000424DAE0000000000000076000000280000000E000000070000000100
    … …  
    279206      NumGlyphs = 2
    280207      Spacing = 0
    281       Transparent = False
    282       OnClick = btnXDurationClick
    283208    end
    284209    object txtXDuration: TCaptionEdit
    … …  
    293218    end
    294219  end
     220  object pnlCombo: TPanel
     221    Left = 8
     222    Top = 1
     223    Width = 200
     224    Height = 185
     225    BevelOuter = bvNone
     226    TabOrder = 17
     227    object cboAdditive: TORComboBox
     228      Left = 0
     229      Top = 20
     230      Width = 200
     231      Height = 165
     232      Style = orcsSimple
     233      Align = alClient
     234      AutoSelect = True
     235      Caption = 'Additives'
     236      Color = clWindow
     237      DropDownCount = 11
     238      ItemHeight = 13
     239      ItemTipColor = clWindow
     240      ItemTipEnable = True
     241      ListItemsOnly = True
     242      LongList = True
     243      LookupPiece = 0
     244      MaxLength = 0
     245      Pieces = '2'
     246      Sorted = False
     247      SynonymChars = '<>'
     248      TabPositions = '20'
     249      TabOrder = 0
     250      OnExit = cboAdditiveExit
     251      OnMouseClick = cboAdditiveMouseClick
     252      OnNeedData = cboAdditiveNeedData
     253      CharsNeedMatch = 1
     254    end
     255    object tabFluid: TTabControl
     256      Left = 0
     257      Top = 0
     258      Width = 200
     259      Height = 20
     260      Align = alTop
     261      TabHeight = 15
     262      TabOrder = 1
     263      Tabs.Strings = (
     264        '   Solutions   '
     265        '   Additives   ')
     266      TabIndex = 0
     267      TabStop = False
     268      OnChange = tabFluidChange
     269    end
     270    object cboSolution: TORComboBox
     271      Left = 0
     272      Top = 20
     273      Width = 200
     274      Height = 165
     275      Style = orcsSimple
     276      Align = alClient
     277      AutoSelect = True
     278      Caption = 'Solutions'
     279      Color = clWindow
     280      DropDownCount = 11
     281      ItemHeight = 13
     282      ItemTipColor = clWindow
     283      ItemTipEnable = True
     284      ListItemsOnly = True
     285      LongList = True
     286      LookupPiece = 0
     287      MaxLength = 0
     288      Pieces = '2'
     289      Sorted = False
     290      SynonymChars = '<>'
     291      TabPositions = '20'
     292      TabOrder = 2
     293      OnExit = cboSolutionExit
     294      OnMouseClick = cboSolutionMouseClick
     295      OnNeedData = cboSolutionNeedData
     296      CharsNeedMatch = 1
     297    end
     298  end
    295299  object popDuration: TPopupMenu
    296300    AutoHotkeys = maManual

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedIV.pas

    r459 r460  
    99type
    1010  TfrmODMedIV = class(TfrmODBase)
    11     tabFluid: TTabControl;
    12     cboSolution: TORComboBox;
    1311    lblInfusionRate: TLabel;
    1412    txtRate: TCaptionEdit;
    15     lblPriority: TLabel;
    16     cboPriority: TORComboBox;
    1713    lblComponent: TLabel;
    1814    lblAmount: TLabel;
    … …  
    2117    lblComments: TLabel;
    2218    memComments: TCaptionMemo;
    23     cboAdditive: TORComboBox;
    2419    txtSelected: TCaptionEdit;
    2520    cboSelected: TCaptionComboBox;
    26     Label1: TStaticText;
    2721    popDuration: TPopupMenu;
    2822    popML: TMenuItem;
    … …  
    3327    txtXDuration: TCaptionEdit;
    3428    lblLimit: TLabel;
    35     btnXDuration: TSpeedButton;
     29    btnXDuration: TBitBtn;
     30    pnlCombo: TPanel;
     31    cboAdditive: TORComboBox;
     32    tabFluid: TTabControl;
     33    cboSolution: TORComboBox;
     34    lblPriority: TLabel;
     35    cboPriority: TORComboBox;
    3636    procedure FormCreate(Sender: TObject);
    3737    procedure tabFluidChange(Sender: TObject);
    … …  
    6464    procedure pnlXDurationEnter(Sender: TObject);
    6565    procedure txtXDurationExit(Sender: TObject);
     66    procedure txtRateExit(Sender: TObject);
    6667  private
    6768    FInpatient: Boolean;
    … …  
    8485{$R *.DFM}
    8586
    86 uses ORFn, uConst, rODMeds, rODBase, uAccessibleStringGrid;
     87uses ORFn, uConst, rODMeds, rODBase, uAccessibleStringGrid, fFrame;
    8788
    8889const
    … …  
    129130  Restriction: string;
    130131begin
     132  frmFrame.pnlVisit.Enabled := false;
    131133  inherited;
    132134  AllowQuickOrder := True;
    … …  
    155157  with grdSelected do for i := 0 to RowCount - 1 do TIVComponent(Objects[0, i]).Free;
    156158  inherited;
     159  frmFrame.pnlVisit.Enabled := True;
    157160end;
    158161
    … …  
    454457    end;
    455458  end;
     459  Application.ProcessMessages;         //CQ: 10157
    456460  ClickOnGridCell;
    457   if cboAdditive.Visible then
    458     ActiveControl := cboAdditive;
    459461  ControlChange(Sender);
    460462end;
    … …  
    522524    Col := 1;
    523525  end;
     526  Application.ProcessMessages;         //CQ: 10157
    524527  ClickOnGridCell;
    525528  ControlChange(Sender);
    … …  
    550553      Show;
    551554      SetFocus;
     555      if AControl is TComboBox then                    //CQ: 10157
     556        TComboBox(AControl).DroppedDown := True;
    552557    end;
    553558  end;
    … …  
    855860procedure TfrmODMedIV.txtXDurationExit(Sender: TObject);
    856861var
     862  Len: Integer;
    857863  Code: double;
     864  Digits, Warning: string;
    858865begin
    859866  inherited;
    860867  if Changing then Exit;
     868  //AGP Change 26.15 HIN-1203-42283 Added additional check to make sure the user can only enter the correct duration
     869  Len := Length(txtXDuration.Text);
     870  if (Len > 0) and (Pos('.', txtXDuration.Text)=0) then
     871    begin
     872      Warning := '0';
     873      Digits := '2';
     874      if ((btnXDuration.Caption = 'days') or (btnXDuration.Caption = 'hours') or (btnXDuration.Caption = 'L')) and (Len > 2) then  Warning := '1';
     875      if (btnXDuration.Caption = 'ml') and (Len > 4) then  Warning := '1';
     876      if Warning = '1' then
     877          begin
     878             if btnXduration.Caption = 'ml' then Digits := '4';
     879             ShowMessage('Invalid Value.' + #13#10 + 'Reason: Duration for ' + btnXDuration.Caption + ' cannot be greater than ' + digits + ' digits.');
     880             txtXDuration.Text := '';
     881             txtXDuration.SetFocus;
     882             Exit;
     883          end;
     884      end;
    861885  if (Pos('.', txtXDuration.Text)>0) and
    862886     ((btnXduration.Caption = 'days') or (btnXduration.Caption = 'hours')) then
    … …  
    897921end;
    898922
     923procedure TfrmODMedIV.txtRateExit(Sender: TObject);
     924var
     925ErrorText, LDec,RDec: string;
     926i: Integer;
     927Result: boolean;
     928begin
     929  inherited;
     930  //AGP Change 26.28 for CQ # 7598 add infusion rate check for valid value
     931  ErrorText := 'The Infusion Rate must be in one of the following formats:' + CRLF + CRLF + 'nnnn.nn ml/hr or text@per labels per day';
     932  Result := False;
     933  if pos('@',Self.txtRate.Text)>0 then exit;
     934  if pos('.',Self.txtRate.Text)>0 then
     935      begin
     936         LDec := Piece(Self.txtRate.Text,'.',1);
     937         RDec := Piece(Self.txtRate.Text,'.',2);
     938         if Length(LDec)>4 then Result := True;
     939         if Length(RDec)>2 then Result := True;
     940      end
     941  else if Length(Self.txtRate.Text)>4 then Result := True;
     942  if (Result = False) and (pos('.',Self.txtRate.Text)=0) then
     943    begin
     944    for i := 1 to Length(Self.txtRate.Text) do if not (Self.txtRate.Text[i] in ['0'..'9']) then Result := True
     945    end;
     946  if Result = True then
     947    begin
     948       InfoBox(ErrorText,'Warning - Invalid Infusion Rate', MB_OK);
     949       Self.txtRate.Text := '';
     950       Self.txtRate.SetFocus;
     951    end;
     952end;
     953
    899954end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedNVA.dfm

    r459 r460  
    11inherited frmODMedNVA: TfrmODMedNVA
    2   Left = 168
    3   Top = 36
     2  Left = 100
     3  Top = 167
    44  Width = 632
    55  Height = 536
    … …  
    5757      Height = 133
    5858      Align = alTop
     59      BevelInner = bvLowered
     60      BevelOuter = bvSpace
    5961      Columns = <
    6062        item
    … …  
    6365      ColumnClick = False
    6466      HideSelection = False
     67      HotTrack = True
    6568      OwnerData = True
    6669      ParentShowHint = False
    … …  
    7174      ViewStyle = vsReport
    7275      OnChange = lstChange
     76      OnClick = ListViewClick
    7377      OnData = lstQuickData
     78      OnEditing = ListViewEditing
     79      OnEnter = ListViewEnter
     80      OnResize = ListViewResize
    7481      Caption = 'Quick Orders'
    7582    end
    … …  
    215222        OnExit = cboDosageExit
    216223        CharsNeedMatch = 1
    217         UniqueAutoComplete = True
    218224      end
    219225      object cboRoute: TORComboBox
    … …  
    245251        OnExit = cboRouteExit
    246252        CharsNeedMatch = 1
    247         UniqueAutoComplete = True
    248253      end
    249254      object cboSchedule: TORComboBox
    … …  
    273278        OnExit = cboScheduleExit
    274279        CharsNeedMatch = 1
    275         UniqueAutoComplete = True
    276280      end
    277281      object chkPRN: TCheckBox
    … …  
    285289        ParentColor = False
    286290        TabOrder = 5
     291        OnClick = chkPRNClick
    287292      end
    288293    end
    … …  
    308313      object Label1: TLabel
    309314        Left = 5
    310         Top = 50
     315        Top = 47
    311316        Width = 108
    312317        Height = 13
    … …  
    319324        Height = 13
    320325        Caption = 'Start Date:'
     326      end
     327      object Image1: TImage
     328        Left = 25
     329        Top = 17
     330        Width = 31
     331        Height = 31
    321332      end
    322333      object memComment: TCaptionMemo
    … …  
    354365      end
    355366      object lbStatements: TORListBox
    356         Left = 8
    357         Top = 62
     367        Left = 7
     368        Top = 59
    358369        Width = 603
    359         Height = 76
     370        Height = 81
    360371        Style = lbOwnerDrawFixed
    361372        Anchors = [akLeft, akTop, akRight]
    … …  
    370381        OnClickCheck = lbStatementsClickCheck
    371382      end
     383      object memDrugMsg: TMemo
     384        Left = 63
     385        Top = 15
     386        Width = 533
     387        Height = 31
     388        Anchors = [akLeft, akRight, akBottom]
     389        Color = clCream
     390        Lines.Strings = (
     391          '')
     392        ReadOnly = True
     393        ScrollBars = ssVertical
     394        TabOrder = 6
     395        Visible = False
     396      end
    372397    end
    373398  end
    374399  object btnSelect: TButton
    375400    Left = 539
    376     Top = 461
     401    Top = 463
    377402    Width = 72
    378403    Height = 21

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedNVA.pas

    r459 r460  
    11unit fODMedNVA;
    22
    3 interface                         
     3interface
    44
    55uses
    … …  
    4141    Label2: TLabel;
    4242    btnSelect: TButton;
     43    Image1: TImage;
     44    memDrugMsg: TMemo;
    4345    procedure FormCreate(Sender: TObject);
    4446    procedure btnSelectClick(Sender: TObject);
    … …  
    6870    procedure cboScheduleClick(Sender: TObject);
    6971    procedure cboRouteExit(Sender: TObject);
    70 
     72    procedure DispOrderMessage(const AMessage: string);
    7173
    7274
    … …  
    8991      Change: TItemChange);
    9092    procedure FormKeyPress(Sender: TObject; var Key: Char);
     93
    9194  private
    9295    {selection}
    … …  
    121124    FPtInstruct: string;
    122125    FAltChecked: Boolean;
     126    FShrinkDrugMsg: boolean;
    123127    FQOQuantity: Double;
    124128    FQODosage: string;
    … …  
    129133    FDisabledCancelButton: TButton;
    130134    FShrinked: boolean;
     135    FQOInitial: boolean;
    131136    FRemoveText : Boolean;
    132137    {selection}
    … …  
    291296  TX_NO_FUTURE_DATES  = 'Dates in the future are not allowed.';
    292297  TX_BAD_DATE         = 'Dates must be in the format mm/dd/yy or mm/yy';
    293 
     298  TX_CAP_FUTURE       = 'Invalid date';
    294299
    295300{ procedures inherited from fODBase --------------------------------------------------------- }
    … …  
    300305var
    301306  ListCount: Integer;
    302   Restriction, x : string;
    303 begin
     307  Restriction, x: string;
     308begin
     309  frmFrame.pnlVisit.Enabled := false;
    304310  AutoSizeDisabled := True;
    305311 // ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
    306312  inherited;
     313  AllowQuickOrder := True;
     314
    307315  if User.OrderRole in[OR_CLERK] then   // if user is clerk check restrictions else ok to write NonVA Order.
    308   begin
    309      CheckAuthForNVAMeds(Restriction);
    310      if Length(Restriction) > 0 then
    311      begin
    312        InfoBox(Restriction, TC_RESTRICT, MB_OK);
    313        Close;
    314        Exit;
    315      end;
    316   end;
     316    begin
     317      CheckAuthForNVAMeds(Restriction);
     318      if Length(Restriction) > 0 then
     319        begin
     320          CheckAuthForNVAMeds(Restriction);
     321          if Length(Restriction) > 0 then
     322            begin
     323              InfoBox(Restriction, TC_RESTRICT, MB_OK);
     324              Close;
     325              Exit;
     326            end;
     327        end;
     328    end;  // clerk restrictions
    317329
    318330  if DlgFormID = OD_MEDNONVA  then FNonVADlg := TRUE;
    … …  
    363375  LoadOTCStatements(lbStatements.Items);
    364376  FRemoveText := True;
     377  FShrinkDrugMsg := False;
    365378end;
    366379
    … …  
    376389 // TAccessibleStringGrid.UnwrapControl(grdDoses);
    377390  inherited;
     391  frmFrame.pnlVisit.Enabled := true;
    378392end;
    379393
    … …  
    401415procedure TfrmODMedNVA.SetupDialog(OrderAction: Integer; const ID: string);
    402416var
     417  //AnInstr: string;
    403418  OrderID: string;
    404419begin
    … …  
    429444    Changing := False;
    430445  end;
    431 
     446  { prevent the SIG from being part of the comments on pre-CPRS prescriptions }
     447  {if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboDosage.Text = '') then  //commented out by cla 2/27/04 - CQ 2591
     448  begin
     449    OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
     450    AnInstr := TextForOrder(OrderID);
     451    pnlMessage.TabOrder := 0;
     452    OrderMessage(AnInstr);
     453    if OrderAction = ORDER_COPY
     454      then AnInstr := 'Copy: ' + AnInstr
     455      else AnInstr := 'Change: ' + AnInstr;
     456    Caption := AnInstr;
     457    memComment.Clear;  // sometimes the sig is in the comment
     458    lbStatements.Clear;
     459  end;}
    432460  ControlChange(Self);
    433461end;
    … …  
    527555end;
    528556
    529 
    530557{ Navigate medication selection lists ------------------------------------------------------- }
    531558
    … …  
    607634var
    608635  Offset: Integer;
     636  SelRect: TRect;
    609637begin
    610638  AListView.Selected.MakeVisible(FALSE);
     639  SelRect := AListView.Selected.DisplayRect(drBounds);   //  CQ: 6636
     640  FRowHeight := SelRect.Bottom - SelRect.Top;
    611641  Offset := AListView.Selected.Index - AListView.TopItem.Index;
    612642  Application.ProcessMessages;
    … …  
    803833    Changing := True;
    804834    ResetOnMedChange;
    805   if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then  // orderable item
     835    if (FActiveMedList = lstQuick) and (lstQuick.Selected <> nil) then   // quick order
     836    begin
     837      ErrMsg := '';
     838      FIsQuickOrder := True;
     839      FQOInitial := True;
     840      Responses.QuickOrder := Integer(lstQuick.Selected.Data);
     841      txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
     842      IsActivateOI(ErrMsg, txtMed.Tag);
     843      if Length(ErrMsg)>0 then
     844      begin
     845        //btnSelect.Visible := False;
     846        btnSelect.Enabled := False;
     847        ShowMessage(ErrMsg);
     848        Exit;
     849      end;
     850      if txtMed.Tag = 0 then
     851      begin
     852        //btnSelect.Visible := False;
     853        btnSelect.Enabled := False;
     854        txtMed.SetFocus;
     855        Exit;
     856      end;
     857      SetOnMedSelect;   // set up for this medication
     858      SetOnQuickOrder;  // insert quick order responses
     859      ShowMedFields;
     860    end
     861    else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then  // orderable item
    806862    begin
    807863      MedIEN := Integer(lstAll.Selected.Data);
    … …  
    831887      ShowMedFields;
    832888    end
    833     else                                                                 // no selection
     889    else                                           // no selection
    834890    begin
    835891      MessageBeep(0);
    … …  
    842898  else ShowMedSelect;                             // show the selection fields
    843899  FNoZERO   := False;
    844 
    845900end;
    846901
    … …  
    848903begin
    849904  cboDosage.Items.Clear;
     905  chkPRN.Checked := False;
     906  cboSchedule.ItemIndex := -1;
     907  cboSchedule.Text := '';  // leave items intact
     908  memComment.Lines.Clear;
    850909  cboDosage.Text := '';
    851910  cboRoute.Items.Clear;
    … …  
    867926  QOPiUnChk := False;
    868927  PKIEnviron := False;
    869   if GetPKISite and GetPKIUse then  //PKI check for crypto object on workstation
    870     begin
    871       try  //PKI object creation
    872         crypto := CoXuDigSigS.Create;
    873         crypto.GetCSP;
    874         StatusText(crypto.Reason);
    875         PKIEnviron := True;
    876       except
    877         on  E: Exception do
    878           begin
    879             {ShowMessage('An error has been encountered while trying to create PKI environment: '+ E.Message +
    880             '.  This order will be processed without Digital Signature encryption.');}
    881             PKIEnviron := False;
    882           end;
    883       end;
    884       crypto := nil;
    885     end;
    886   if PKIEnviron = False then
    887     if GetPKISite then PKIEnviron := True;
     928  if GetPKISite then PKIEnviron := True;
    888929  with CtrlInits do
    889930  begin
    … …  
    950991 //   end;
    951992    pnlMessage.TabOrder := cboDosage.TabOrder + 1;
    952     OrderMessage(TextOf('Message'));
     993
     994 //   DispOrderMessage(TextOf('Message'));
    953995  end;
    954996end;
    … …  
    9711013        with cboDosage do
    9721014          if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
     1015
    9731016        SetControl(cboRoute,  'ROUTE', i);
    9741017        with cboRoute do
    … …  
    10011044      else
    10021045        SetDosage(IValueFor('INSTR', 1));
    1003         SetControl(cboRoute,  'ROUTE',     1);
     1046        SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776
    10041047        SetSchedule(IValueFor('SCHEDULE',  1));
    10051048      if (cboSchedule.Text = '') and FIsQuickOrder then
    … …  
    11741217  NonPRNPart: string;
    11751218begin
     1219 
    11761220  cboSchedule.ItemIndex := -1;
    11771221  if Pos('PRN', x) > 0 then
    … …  
    11791223    NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
    11801224    cboSchedule.SelectByID(NonPRNPart);
    1181     if cboSchedule.ItemIndex > -1 then chkPRN.Checked := True else
    1182     begin
    1183       cboSchedule.SelectByID(x);
    1184       if cboSchedule.ItemIndex < 0 then cboSchedule.Text := x;
    1185     end;
     1225    if cboSchedule.ItemIndex < 0 then
     1226    begin
     1227      if NSSchedule then
     1228      begin
     1229        chkPRN.Checked := False;
     1230        cboSchedule.Text := '';
     1231      end else
     1232      begin
     1233        chkPRN.Checked := True;
     1234        cboSchedule.Items.Add(NonPRNPart);
     1235        cboSchedule.Text := NonPRNPart;
     1236      end;
     1237    end else
     1238      chkPRN.Checked := True;
    11861239  end else
    11871240  begin
    11881241    chkPRN.Checked := False;
    11891242    cboSchedule.SelectByID(x);
    1190     if cboSchedule.ItemIndex < 0 then cboSchedule.Text := x;
     1243    if cboSchedule.ItemIndex < 0 then
     1244    begin
     1245      if NSSchedule then
     1246      begin
     1247        cboSchedule.Text := '';
     1248      end
     1249      else
     1250      begin
     1251        cboSchedule.Items.Add(x);
     1252        cboSchedule.Text := x;
     1253        cboSchedule.SelectByID(x);
     1254      end;
     1255    end;
    11911256  end;
    11921257end;
    … …  
    12461311var
    12471312  DispDrug: Integer;
    1248   x: string;
    1249 begin
    1250   inherited;
    1251   UpdateRelated(False);
     1313begin
     1314  inherited;
     1315UpdateRelated(False);
    12521316  DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
    12531317  if cboDosage.Text = '' then    //cla 3/18/04
    … …  
    12561320    cboDosage.ItemIndex := -1;
    12571321  end;
     1322  {  hds8084
    12581323  if DispDrug > 0 then
    12591324  begin
    12601325    if not FSuppressMsg then begin
    12611326      pnlMessage.TabOrder := cboDosage.TabOrder + 1;
    1262       OrderMessage(DispenseMessage(DispDrug));
     1327      DispOrderMessage(DispenseMessage(DispDrug));
    12631328    end;
    12641329    x := QuantityMessage(DispDrug);
    12651330  end
    12661331  else x := '';
     1332  }
    12671333  with cboDosage do
    12681334    if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) = 'NF')
    … …  
    15891655                                then Responses.Update('ROUTE',    1, ValueOf(FLD_ROUTE_ID), x)
    15901656                                else Responses.Update('ROUTE',    1, '', x);
    1591  //     x := ValueOf(FLD_SCHEDULE);    Responses.Update('SCHEDULE', 1, x,  x);
     1657      x := ValueOf(FLD_SCHEDULE);    Responses.Update('SCHEDULE', 1, x,  x); // CQ:7297, 7534
    15921658    end;
    15931659  end; {case TabDose.TabIndex}
    … …  
    15981664  if Length(calStart.Text) > 0 then
    15991665     Responses.Update('START', 1, calStart.Text, 'Start Date: ' + calStart.Text);  //cla 7-17-03
    1600 
     1666     
    16011667  x := ValueOf(FLD_STATEMENTS);
    16021668  Responses.Update('STATEMENTS',1, TX_WPTYPE, x);
    … …  
    16971763                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
    16981764    FLD_SCHEDULE  : begin
    1699                       Result := cboSchedule.Text;
     1765                      Result := UpperCase(cboSchedule.Text);
    17001766                      if chkPRN.Checked then Result := Result + ' PRN';
    17011767                      if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
    … …  
    17681834  if Length(CurSchedule)=0 then Exit;
    17691835  ASchedule := Trim(CurSchedule);
    1770   if (Pos('^',ASchedule)=0) then
     1836  {if (Pos('^',ASchedule)=0) then  //GE  CQ7506
    17711837  begin
    17721838    PrnPos := Pos('PRN',ASchedule);
    17731839    if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1) <> ';') then
    17741840      Delete(ASchedule, PrnPos, Length(ASchedule));
    1775   end
    1776   else if (Pos('^',ASchedule)>0) then
     1841  end  }
     1842  if (Pos('^',ASchedule)>0) then
    17771843  begin
    17781844    PrnPos := Pos('PRN',ASchedule);
    … …  
    19291995    begin
    19301996      Val(TabletNum, ie, code);
     1997      if ie = 0 then begin end;
    19311998      if code <> 0 then
    19321999        Exit;
    … …  
    19672034
    19682035procedure TfrmODMedNVA.chkPRNClick(Sender: TObject);
    1969 begin
    1970   inherited;
    1971   if chkPRN.Checked then lblAdminTime.Caption := ''
     2036var
     2037  tempSch: string;
     2038  PRNPos: integer;
     2039begin
     2040  inherited;
     2041  {if chkPRN.Checked then lblAdminTime.Caption := ''
    19722042  else
    19732043  begin
    19742044    lblAdminTime.Caption := FAdminTimeLbl;
     2045  end;
     2046  ControlChange(Self);
     2047  }
     2048  if chkPRN.Checked then
     2049  begin
     2050     lblAdminTime.Caption := '';
     2051     PrnPos := Pos('PRN',cboSchedule.Text);
     2052     if (PrnPos < 1) then
     2053        UpdateStartExpires(cboSchedule.Text + ' PRN');
     2054  end
     2055  else
     2056  begin
     2057    if Length(Trim(cboSchedule.Text))>0 then
     2058    begin
     2059      tempSch := ';'+Trim(cboSchedule.Text);
     2060      UpdateStartExpires(tempSch);
     2061    end;
     2062    lblAdminTime.Caption := FAdminTimeLbl;
     2063   
    19752064  end;
    19762065  ControlChange(Self);
    … …  
    21942283end;
    21952284
     2285procedure TfrmODMedNVA.DispOrderMessage(const AMessage: string);
     2286begin
     2287  if ContainsVisibleChar(AMessage) then
     2288  begin
     2289    image1.Visible := True;
     2290    memDrugMsg.Visible := True;
     2291    image1.Picture.Icon.Handle := LoadIcon(0, IDI_ASTERISK);
     2292    memDrugMsg.Lines.Clear;
     2293    memDrugMsg.Lines.SetText(PChar(AMessage));
     2294    if fShrinkDrugMsg then
     2295    begin
     2296      pnlBottom.Height := pnlBottom.Height + memDrugMsg.Height + 2;
     2297      fShrinkDrugMsg := False;
     2298    end;
     2299  end else
     2300  begin
     2301    image1.Visible := False;
     2302    memDrugMsg.Visible := False;
     2303    if not fShrinkDrugMsg then
     2304  //  begin
     2305  //    pnlBottom.Height := pnlBottom.Height - memDrugMsg.Height - 2;
     2306      fShrinkDrugMsg := True;
     2307 //   end;
     2308  end;
     2309end;
     2310
    21962311end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedOIFA.dfm

    r459 r460  
    1 inherited frmODMedOIFA: TfrmODMedOIFA
    2   Width = 316
     1object frmODMedOIFA: TfrmODMedOIFA
     2  Left = 0
     3  Top = 0
     4  Width = 313
    35  Height = 205
    46  Caption = 'Formulary Alternatives'
     7  Color = clBtnFace
     8  Font.Charset = DEFAULT_CHARSET
     9  Font.Color = clWindowText
     10  Font.Height = -11
     11  Font.Name = 'MS Sans Serif'
     12  Font.Style = []
     13  FormStyle = fsStayOnTop
     14  OldCreateOrder = True
     15  Position = poMainFormCenter
     16  OnClose = FormClose
    517  OnCreate = FormCreate
     18  OnShow = FormShow
    619  PixelsPerInch = 96
    720  TextHeight = 13
    821  object Label1: TLabel
    9     Left = 8
    10     Top = 8
    11     Width = 273
     22    Left = 0
     23    Top = 0
     24    Width = 305
    1225    Height = 13
     26    Align = alTop
    1327    Caption = 'The selected drug is not in the formulary.  Alternatives are:'
    1428  end
    1529  object Label2: TStaticText
    16     Left = 8
    17     Top = 127
    18     Width = 250
     30    Left = 0
     31    Top = 134
     32    Width = 305
    1933    Height = 17
     34    Align = alBottom
    2035    Caption = 'Do you wish to use the selected alternative instead?'
    21     TabOrder = 3
     36    TabOrder = 1
    2237  end
    2338  object lstFormAlt: TORListBox
    24     Left = 8
    25     Top = 22
    26     Width = 292
    27     Height = 97
     39    Left = 0
     40    Top = 13
     41    Width = 305
     42    Height = 121
     43    Align = alClient
    2844    ItemHeight = 13
    2945    ParentShowHint = False
    … …  
    3652    Pieces = '2'
    3753  end
    38   object cmdYes: TButton
    39     Left = 74
    40     Top = 148
    41     Width = 72
    42     Height = 21
    43     Caption = 'Yes'
    44     Default = True
    45     Enabled = False
    46     TabOrder = 1
    47     OnClick = cmdYesClick
    48   end
    49   object cmdNo: TButton
    50     Left = 162
    51     Top = 148
    52     Width = 72
    53     Height = 21
    54     Cancel = True
    55     Caption = 'No'
    56     TabOrder = 2
    57     OnClick = cmdNoClick
     54  object btnPanel: TPanel
     55    Left = 0
     56    Top = 151
     57    Width = 305
     58    Height = 27
     59    Align = alBottom
     60    BevelOuter = bvNone
     61    TabOrder = 3
     62    object cmdYes: TButton
     63      Left = 74
     64      Top = 3
     65      Width = 72
     66      Height = 21
     67      Caption = 'Yes'
     68      Default = True
     69      Enabled = False
     70      TabOrder = 0
     71      OnClick = cmdYesClick
     72    end
     73    object cmdNo: TButton
     74      Left = 162
     75      Top = 3
     76      Width = 72
     77      Height = 21
     78      Cancel = True
     79      Caption = 'No'
     80      TabOrder = 1
     81      OnClick = cmdNoClick
     82    end
    5883  end
    5984end

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedOIFA.pas

    r459 r460  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORCtrls;
     7  StdCtrls, ORCtrls, ExtCtrls, fAutoSz;
    88
    99type
    10   TfrmODMedOIFA = class(TfrmAutoSz)
     10  TfrmODMedOIFA = class(TForm)
    1111    Label1: TLabel;
    1212    lstFormAlt: TORListBox;
    1313    Label2: TStaticText;
     14    btnPanel: TPanel;
    1415    cmdYes: TButton;
    1516    cmdNo: TButton;
    … …  
    1819    procedure cmdNoClick(Sender: TObject);
    1920    procedure lstFormAltClick(Sender: TObject);
     21    procedure FormShow(Sender: TObject);
     22    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    2023  private
    2124    FSelected: string;
    … …  
    3033{$R *.DFM}
    3134
    32 uses ORFn, rODMeds;
     35uses ORFn, rODMeds, rMisc;
    3336
    3437procedure CheckFormularyOI(var AnIEN: Integer; var AName: string; ForInpatient: Boolean);
    … …  
    130133end;
    131134
     135procedure TfrmODMedOIFA.FormShow(Sender: TObject);
     136begin
     137  inherited;
     138  SetFormPosition(Self);
     139end;
     140
     141procedure TfrmODMedOIFA.FormClose(Sender: TObject;
     142  var Action: TCloseAction);
     143begin
     144  inherited;
     145  SaveUserBounds(Self); 
     146end;
     147
    132148end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMeds.dfm

    r459 r460  
    11inherited frmODMeds: TfrmODMeds
    2   Left = 202
    3   Top = 61
     2  Left = 519
     3  Top = 204
    44  Width = 584
    5   Height = 494
     5  Height = 515
    66  HorzScrollBar.Range = 558
    7   HorzScrollBar.Visible = True
    87  VertScrollBar.Range = 399
    9   VertScrollBar.Visible = True
    10   AutoScroll = False
    118  Caption = 'Medication Order'
    129  Constraints.MinHeight = 325
    … …  
    1512  DesignSize = (
    1613    576
    17     460)
     14    488)
    1815  PixelsPerInch = 96
    1916  TextHeight = 13
    … …  
    2219    Top = 34
    2320    Width = 580
    24     Height = 392
     21    Height = 413
    2522    Anchors = [akLeft, akTop, akRight, akBottom]
    2623    BevelOuter = bvNone
    … …  
    7168      Top = 137
    7269      Width = 580
    73       Height = 255
     70      Height = 276
    7471      Align = alClient
    7572      BevelInner = bvLowered
    … …  
    10198  end
    10299  inherited memOrder: TCaptionMemo
    103     Top = 427
     100    Top = 448
    104101    Width = 502
    105102    Anchors = [akLeft, akRight, akBottom]
    … …  
    122119  object btnSelect: TButton [3]
    123120    Left = 515
    124     Top = 427
     121    Top = 448
    125122    Width = 72
    126123    Height = 21
    … …  
    134131  inherited cmdAccept: TButton
    135132    Left = 514
    136     Top = 427
     133    Top = 448
    137134    Anchors = [akRight, akBottom]
    138135    TabOrder = 6
    … …  
    142139  inherited cmdQuit: TButton
    143140    Left = 514
    144     Top = 452
     141    Top = 473
    145142    Width = 51
    146143    Anchors = [akRight, akBottom]
    … …  
    159156    Top = 34
    160157    Width = 580
    161     Height = 392
     158    Height = 413
    162159    Anchors = [akLeft, akTop, akRight, akBottom]
    163160    BevelOuter = bvNone
    … …  
    170167      Top = 0
    171168      Width = 580
    172       Height = 173
     169      Height = 184
    173170      Align = alClient
    174171      Constraints.MinHeight = 80
    … …  
    176173      DesignSize = (
    177174        580
    178         173)
     175        184)
    179176      object lblRoute: TLabel
    180177        Left = 280
    … …  
    197194      end
    198195      object txtNSS: TLabel
    199         Left = 452
     196        Left = 442
    200197        Top = 22
    201         Width = 76
     198        Width = 71
    202199        Height = 13
    203200        Anchors = [akTop, akRight]
    204         Caption = '(Non-standard?)'
     201        Caption = '(Day-Of-Week)'
    205202        Font.Charset = DEFAULT_CHARSET
    206203        Font.Color = clBlue
    … …  
    217214        Top = 36
    218215        Width = 580
    219         Height = 132
     216        Height = 143
    220217        Anchors = [akLeft, akTop, akRight, akBottom]
    221218        ColCount = 6
    … …  
    280277        Top = 36
    281278        Width = 279
    282         Height = 132
     279        Height = 143
    283280        Anchors = [akLeft, akTop, akRight, akBottom]
    284281        Style = orcsSimple
    … …  
    302299        OnClick = cboDosageClick
    303300        OnExit = cboDosageExit
     301        OnKeyUp = cboDosageKeyUp
    304302        CharsNeedMatch = 1
    305303        UniqueAutoComplete = True
    … …  
    309307        Top = 36
    310308        Width = 113
    311         Height = 132
     309        Height = 143
    312310        Anchors = [akTop, akRight, akBottom]
    313311        Style = orcsSimple
    … …  
    339337        Top = 36
    340338        Width = 178
    341         Height = 132
     339        Height = 143
    342340        Anchors = [akTop, akRight, akBottom]
    343341        Style = orcsSimple
    … …  
    426424      OnExit = cboXDosageExit
    427425      OnKeyDown = memMessageKeyDown
     426      OnKeyUp = cboXDosageKeyUp
    428427      CharsNeedMatch = 1
    429428      UniqueAutoComplete = True
    … …  
    546545        Width = 38
    547546        Height = 19
     547        Hint = 'A duration must be defined if using "Then" as a sequence.'
    548548        Caption = 'then'
    549549        Glyph.Data = {
    … …  
    556556        Layout = blGlyphRight
    557557        NumGlyphs = 2
     558        ParentShowHint = False
     559        ShowHint = True
    558560        Spacing = 1
    559561        OnClick = btnXSequenceClick
     562      end
     563      object SpeedButton1: TSpeedButton
     564        Left = 16
     565        Top = 16
     566        Width = 23
     567        Height = 22
    560568      end
    561569    end
    … …  
    598606        OnChange = cboXScheduleChange
    599607        OnClick = cboXScheduleClick
     608        OnEnter = cboXScheduleEnter
    600609        OnExit = cboXScheduleExit
    601610        OnKeyDown = memMessageKeyDown
    … …  
    617626    object pnlBottom: TPanel
    618627      Left = 0
    619       Top = 173
     628      Top = 184
    620629      Width = 580
    621       Height = 219
     630      Height = 229
    622631      Align = alBottom
    623632      TabOrder = 6
    624633      DesignSize = (
    625634        580
    626         219)
     635        229)
    627636      object lblComment: TLabel
    628637        Left = 4
    … …  
    666675      end
    667676      object Image1: TImage
    668         Left = 1
    669         Top = 183
     677        Left = 5
     678        Top = 177
    670679        Width = 31
    671680        Height = 31
    … …  
    686695        Top = 2
    687696        Width = 513
    688         Height = 44
     697        Height = 43
    689698        Anchors = [akLeft, akTop, akRight]
    690699        ScrollBars = ssVertical
    … …  
    707716        Width = 60
    708717        Height = 21
     718        AutoSize = False
    709719        TabOrder = 1
    710720        Text = '0'
    711721        OnChange = txtSupplyChange
     722        OnClick = txtSupplyClick
    712723        Caption = 'Days Supply'
    713724      end
    … …  
    728739        Width = 60
    729740        Height = 21
     741        AutoSize = False
    730742        TabOrder = 3
    731743        Text = '0'
    732744        OnChange = txtQuantityChange
     745        OnClick = txtQuantityClick
    733746        Caption = 'Quantity'
    734747      end
    … …  
    750763        Width = 30
    751764        Height = 21
     765        AutoSize = False
    752766        TabOrder = 5
    753767        Text = '0'
    754768        OnChange = ControlChange
     769        OnClick = txtRefillsClick
    755770        Caption = 'Refills'
    756771      end
    … …  
    817832        ItemTipColor = clWindow
    818833        ItemTipEnable = True
    819         ListItemsOnly = False
     834        ListItemsOnly = True
    820835        LongList = False
    821836        LookupPiece = 0
    … …  
    825840        SynonymChars = '<>'
    826841        TabOrder = 10
    827         Text = 'ROUTINE'
    828842        OnChange = ControlChange
    829843        CharsNeedMatch = 1
    … …  
    842856      end
    843857      object lblAdminTime: TStaticText
    844         Left = 267
    845         Top = 104
     858        Left = 262
     859        Top = 120
    846860        Width = 4
    847861        Height = 4
    848862        TabOrder = 16
    849         Visible = False
    850863      end
    851864      object stcPI: TStaticText
    … …  
    885898      object memDrugMsg: TMemo
    886899        Left = 37
    887         Top = 183
     900        Top = 176
    888901        Width = 533
    889         Height = 34
     902        Height = 51
    890903        Anchors = [akLeft, akRight, akBottom]
    891904        Color = clCream

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMeds.pas

    r459 r460  
    8686    memDrugMsg: TMemo;
    8787    txtNSS: TLabel;
     88    SpeedButton1: TSpeedButton;
    8889    procedure FormCreate(Sender: TObject);
    8990    procedure btnSelectClick(Sender: TObject);
    … …  
    186187    procedure cboScheduleExit(Sender: TObject);
    187188    procedure cboXScheduleExit(Sender: TObject);
     189    procedure cboDosageKeyUp(Sender: TObject; var Key: Word;
     190      Shift: TShiftState);
     191    procedure cboXDosageKeyUp(Sender: TObject; var Key: Word;
     192      Shift: TShiftState);
     193    procedure txtSupplyClick(Sender: TObject);
     194    procedure txtQuantityClick(Sender: TObject);
     195    procedure txtRefillsClick(Sender: TObject);
     196    procedure WMClose(var Msg : TWMClose); message WM_CLOSE;
     197    procedure cboXScheduleEnter(Sender: TObject);
    188198    //procedure btnNSSClick(Sender: TObject);
    189199  private
    … …  
    236246    FOrigiMsgDisp: boolean;
    237247    FNSSOther: boolean;
    238     FFromClick: boolean;
     248    {selection}
    239249    FShowPnlXScheduleOk : boolean;
    240250    FRemoveText : Boolean;
    241     {selection}
     251    FSmplPRNChkd: Boolean;
    242252    procedure ChangeDelayed;
    243253    function FindQuickOrder(const x: string): Integer;
    … …  
    302312//    function ValidateRoute(RouteCombo: TORComboBox) : Boolean; Removed based on Site feeback. See CQ: 7518
    303313    function IsSupplyAndOutPatient : boolean;
     314    function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
    304315  protected
    305316    procedure InitDialog; override;
    306317    procedure Validate(var AnErrMsg: string); override;
    307318  public
     319    ARow1: integer;
    308320    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    309321    procedure CheckDecimal(var AStr: string);
    … …  
    319331
    320332uses rCore, uCore, ORFn, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
    321   uAccessibleStringGrid, uOrders, fOtherSchedule, StrUtils;
     333  uAccessibleStringGrid, uOrders, fOtherSchedule, StrUtils, fFrame;
    322334
    323335const
    … …  
    329341  COL_DURATION =  4;
    330342  COL_SEQUENCE =  5;
     343  COL_CHKXPRN  =  6;
    331344  VAL_DOSAGE   = 10;
    332345  VAL_ROUTE    = 20;
    … …  
    334347  VAL_DURATION = 40;
    335348  VAL_SEQUENCE = 50;
     349  VAL_CHKXPRN  = 60;
    336350  TAB          = #9;
    337351  {field identifiers}
    … …  
    387401  TC_NO_DEA     = 'DEA# Required';
    388402  TX_NO_MED     = 'Medication must be selected.';
     403  TX_NO_SEQ     = 'Missing one or more conjunction.';
    389404  TX_NO_DOSE    = 'Dosage must be entered.';
    390405  TX_DOSE_NUM   = 'Dosage may not be numeric only';
    … …  
    422437  x: string;
    423438begin
     439  frmFrame.pnlVisit.Enabled := false;
    424440  AutoSizeDisabled := True;
    425441  inherited;
    426442  btnXDuration.Align := alClient;
    427443  AllowQuickOrder := True;
     444  FSmplPRNChkd := False; // GE CQ7585
    428445  CheckAuthForMeds(x);
    429446  if Length(x) > 0 then
    … …  
    456473  {if not FInptDlg then } Responses.SetPromptFormat('INSTR', '@');
    457474  StatusText('Loading Schedules');
    458   LoadSchedules(cboSchedule.Items, FInptDlg);
     475  //if (Self.EvtID > 0) then LoadSchedules(cboSchedule.Items)
     476  //else LoadSchedules(cboSchedule.Items, FInptDlg);
     477  LoadSchedules(cboSchedule.Items, FInptDlg); 
    459478  StatusText('');
    460479  if FInptDlg then SetControlsInpatient else SetControlsOutpatient;
    … …  
    466485  begin
    467486    txtNss.Visible := True;
     487    //cboSchedule.ListItemsOnly := True;
     488    //cboXSchedule.ListItemsOnly := True;
    468489  end;
    469490  with grdDoses do
    … …  
    537558  FAllDrugs.Free;
    538559  TAccessibleStringGrid.UnwrapControl(grdDoses);
     560  frmFrame.pnlVisit.Enabled := true;
    539561  inherited;
    540562end;
    … …  
    558580  FQOInitial  := False;
    559581  FNSSOther   := False;
    560   FFromClick  := False;
    561582end;
    562583
    563584procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
    564585var
    565   AnInstr, OrderID, nsSch: string;
     586  AnInstr, OrderID, nsSch, Text: string;
    566587  ix: integer;
    567588begin
    … …  
    606627             begin
    607628                SetSchedule(nsSch);
     629                {cboSchedule.SelectByID(nsSch);
     630                if cboSchedule.ItemIndex < 0 then
     631                begin
     632                  cboSchedule.Items.Add(nsSch);
     633                  cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(nsSch);
     634                end;}
    608635             end;
    609636           end;
    … …  
    611638       end;
    612639    end;  //nss
    613     UpdateRelated(FALSE);
     640    if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or
     641    (XfInToOutNow = true) then UpdateRelated(FALSE); //AGP Change
    614642    Changing := False;
    615643  end;
    … …  
    624652      then AnInstr := 'Copy: ' + AnInstr
    625653      else AnInstr := 'Change: ' + AnInstr;
    626     Caption := AnInstr;
     654    Text := AnsiReplaceText(AnInstr,CRLF,'');
     655    Caption := Text;
    627656    memComment.Clear;  // sometimes the sig is in the comment
    628657  end;
    … …  
    654683    // and is not an outpaitent order, then display error text to require route
    655684    if (Length(x) = 0) and (Not IsSupplyAndOutPatient) then
     685    begin
     686      if cboRoute.Showing = true then cboRoute.SetFocus;  //CQ: 7467
    656687      SetError(TX_NO_ROUTE);
     688    end;
    657689    if (Length(x) > 0) and NeedLookup then
    658690    begin
    659691      LookupRoute(x, RouteID, RouteAbbr);
    660692      if RouteID = '0'
    661         then SetError(TX_NF_ROUTE)
     693        then
     694        begin
     695         if cboRoute.Showing = true then cboRoute.SetFocus;    //CQ: 7467
     696        SetError(TX_NF_ROUTE);
     697        end
    662698        else Responses.Update('ROUTE', AnInstance, RouteID, RouteAbbr);
    663699    end;
    … …  
    678714    else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
    679715      then SetError(TX_NO_SCHED);
    680 
    681716    if Length(tmpX) > 0 then
    682717    begin
    … …  
    706741    if (ValueOfResponse(FLD_DRUG_ID, i) = '') then
    707742    begin
    708       if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then SetError(TX_DOSE_NUM);
    709       if Length(Responses.IValueFor('INSTR', i)) > 60       then SetError(TX_DOSE_LEN);
     743      if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then
     744      begin
     745         SetError(TX_DOSE_NUM);
     746         if tabDose.TabIndex = TI_DOSE then
     747            cboDosage.SetFocus;    //CQ: 7467
     748      end;
     749      if Length(Responses.IValueFor('INSTR', i)) > 60       then
     750      begin
     751         SetError(TX_DOSE_LEN);
     752         cboDosage.SetFocus;  //CQ: 7467
     753      end;
    710754    end;
    711755    ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
    … …  
    713757    i := Responses.NextInstance('INSTR', i);
    714758  end;
     759  //AGP Change 26.45 Fix for then/and conjucntion PSI-04-069
     760  if self.tabDose.TabIndex = 1 then
     761    begin
     762       for i := 2 to self.grdDoses.RowCount do
     763         begin
     764           if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
     765             begin
     766              SetError(TX_NO_SEQ);
     767              Exit;
     768             end;
     769         end;
     770    end;
    715771  if not FInptDlg then                            // outpatient stuff
    716772  begin
    … …  
    9531009    UniqueText := False;
    9541010  FFromSelf := True;
     1011  {AutoSelection is only based upon uniquely matching characters.
     1012   Several CQs have been resolved relating to this issue:
     1013   See CQ:
     1014   7326 - Auto complete does not work correctly if user has quick orders in Medication list
     1015   7328 - PSI-05-016: TAM-0205-31170  Med Error due to pre-populated med screen
     1016   6715 PSI-04-044 Orders: NJH-0804-20315  Physician unable to enter medication order
     1017  }
    9551018  if UniqueText then
    9561019  begin
    … …  
    11291192  QOQuantityStr := '';
    11301193  btnSelect.SetFocus;                             // let the exit events finish
     1194
    11311195  if pnlMeds.Visible then                         // display the medication fields
    11321196  begin
    … …  
    12941358  lblQtyMsg.Caption := '';
    12951359  lblQuantity.Caption := 'Quantity';
     1360  FSmplPRNChkd := chkPRN.Checked;  //  GE  CQ7585
    12961361  chkPRN.Checked := False;
    12971362  FLastUnits    := '';
    … …  
    13181383  QOPiUnChk := False;
    13191384  PKIEnviron := False;
    1320   if GetPKISite and GetPKIUse then  //PKI check for crypto object on workstation
    1321     begin
    1322       try  //PKI object creation
    1323         crypto := CoXuDigSigS.Create;
    1324         crypto.GetCSP;
    1325         StatusText(crypto.Reason);
    1326         PKIEnviron := True;
    1327       except
    1328         on  E: Exception do
    1329           begin
    1330             {ShowMessage('An error has been encountered while trying to create PKI environment: '+ E.Message +
    1331             '.  This order will be processed without Digital Signature encryption.');}
    1332             PKIEnviron := False;
    1333           end;
    1334       end;
    1335       crypto := nil;
    1336     end;
    1337   if PKIEnviron = False then
    1338     if GetPKISite then PKIEnviron := True;
     1385  if GetPKISite then PKIEnviron := True;
    13391386  with CtrlInits do
    13401387  begin
    … …  
    13811428      end;
    13821429      pnlTop.Height := pnlFields.Height - pnlBottom.Height;
    1383       chkDoseNow.Top := memComment.Top + memComment.Height + 4;
     1430      chkDoseNow.Top := memComment.Top + memComment.Height + 1;
    13841431      lblPriority.Top := memcomment.Top + memComment.Height + 1;
    13851432      cboPriority.Top := lblPriority.Top + lblPriority.Height;
    13861433      lblAdminTime.Left := chkDoseNow.Left;
    1387       lblAdminTime.Top := chkDoseNow.Top + chkDoseNow.Height + 1;
     1434      lblAdminTime.Top := chkDoseNow.Top + chkDoseNow.Height - 1;
    13881435    end else
    13891436    begin
    … …  
    14561503        SetDosage(IValueFor('INSTR', i));
    14571504        with cboDosage do
    1458           if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
     1505          if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex]
     1506         else x := IValueFor('INSTR',i); //AGP Change 26.41 for CQ 9102 PSI-05-015 affect copy and edit functionality
    14591507        grdDoses.Cells[COL_DOSAGE, i] := x;
    14601508        SetControl(cboRoute,  'ROUTE', i);
    … …  
    14741522          if ItemIndex > -1 then x := x + TAB + Items[ItemIndex];
    14751523        grdDoses.Cells[COL_SCHEDULE, i] := x;
     1524        if chkPRN.Checked = True then grdDoses.Cells[COL_CHKXPRN,i] := '1';
    14761525        grdDoses.Cells[COL_DURATION, i] := IValueFor('DAYS', i);
    14771526        if      IValueFor('CONJ', i) = 'A' then x := 'AND'
    … …  
    15971646  txtMed.SetFocus;
    15981647  FDrugID := '';
    1599   ShowOrderMessage( False );
     1648  //ShowOrderMessage( False );
    16001649end;
    16011650
    … …  
    16281677
    16291678procedure TfrmODMeds.ShowControlsSimple;
    1630 var
    1631   dosagetxt: string;
     1679//var
     1680  //dosagetxt: string;
    16321681begin
    16331682  //Commented out, no longer using CharsNeedMatch Property
    … …  
    16611710procedure TfrmODMeds.ShowControlsComplex;
    16621711
    1663   procedure MoveCombo(SrcCombo, DestCombo: TORComboBox);
    1664   begin
    1665     DestCombo.Items.Clear;
    1666     DestCombo.Items.Assign(SrcCombo.Items);
    1667     DestCombo.ItemIndex := SrcCombo.ItemIndex;
    1668     DestCombo.Text := Piece(SrcCombo.Text, TAB, 1);
    1669   end;
    1670 
    1671 var
    1672   dosagetxt: string;
     1712  procedure MoveCombo(SrcCombo, DestCombo: TORComboBox; CompSch: boolean = false); //AGP Changes 26.12 PSI-04-63
     1713  var
     1714  cnt,i,index: integer;
     1715  node,text: string;
     1716  begin
     1717  if (CompSch = false) or not (FInptDlg)then
     1718    begin
     1719      DestCombo.Items.Clear;
     1720      DestCombo.Items.Assign(SrcCombo.Items);
     1721      DestCombo.ItemIndex := SrcCombo.ItemIndex;
     1722      DestCombo.Text := Piece(SrcCombo.Text, TAB, 1);
     1723    end;
     1724  if (CompSch = true) and (FInptDlg) then     // AGP Changes 26.12 PSI-04-63
     1725    begin
     1726    //AGP change 26.34 CQ 7201,6902 fix the problem with one time schedule still showing for inpatient complex orders
     1727    DestCombo.ItemIndex := -1;
     1728    Text := SrcCombo.Text;
     1729    index := SrcCombo.ItemIndex;
     1730    cnt := 0;
     1731    for i := 0 to SrcCombo.Items.Count - 1 do
     1732      begin
     1733        node := SrcCombo.Items.Strings[i];
     1734        if piece(node,U,3) <> 'O' then
     1735          begin
     1736            DestCombo.Items.Add(SrcCombo.Items.Strings[i]);
     1737            if Piece(node,U,1) = text then DestCombo.ItemIndex := index - cnt;
     1738          end
     1739        else cnt := cnt+1;
     1740      end;
     1741    end;
     1742  end;
     1743
     1744//var
     1745  //dosagetxt: string;
    16731746begin
    16741747  tabDose.TabIndex := TI_COMPLEX;
    16751748  MoveCombo(cboDosage,   cboXDosage);
    16761749  MoveCombo(cboRoute,    cboXRoute);
    1677   MoveCombo(cboSchedule, cboXSchedule);
     1750  MoveCombo(cboSchedule, cboXSchedule, true);  //AGP Changes 26.12 PSI-04-063
    16781751  grdDoses.Visible := True;
    16791752  btnXInsert.Visible := True;
    … …  
    16891762  ActiveControl := grdDoses;
    16901763  //Commented out, no longer using CharsNeedMatch Property
    1691  { NumCharsForMatch := 0;
     1764{ NumCharsForMatch := 0;
    16921765  for i := 0 to cboXDosage.Items.Count - 1 do         //find the shortest unit dose text on fifth piece
    16931766  begin
    … …  
    17191792        Break;
    17201793      end;
    1721     if ((DoseIndex < 0) and (not IsTransferAction)) then Text := x
    1722     else if ((DoseIndex < 0) and IsTransferAction) then Text := ''
     1794    if DoseIndex <0 then Text := x
     1795  (*  if ((DoseIndex < 0) and (not IsTransferAction)) then Text := x
     1796    else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = False) then Text := ''
     1797    else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = True) then Text := x *)
    17231798    else ItemIndex := DoseIndex;
    17241799  end;
    … …  
    17401815procedure TfrmODMeds.SetSchedule(const x: string);
    17411816var
    1742   NonPRNPart: string;
     1817NonPRNPart: string;
    17431818begin
    17441819  cboSchedule.ItemIndex := -1;
    1745   if Pos('PRN', x) > 0 then
     1820  //AGP change CQ 10593, remove code to match the new expected first dose code
     1821  //PSI-05-026
     1822 (* if Pos('PRN', x) > 0 then
    17461823  begin
    17471824    NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
    … …  
    17621839      chkPRN.Checked := True;
    17631840  end else
    1764   begin
     1841  begin  *)
    17651842    chkPRN.Checked := False;
    17661843    cboSchedule.SelectByID(x);
    … …  
    17731850      else
    17741851      begin
    1775         cboSchedule.Items.Add(x);
    1776         cboSchedule.Text := x;
    1777         cboSchedule.SelectByID(x);
     1852      if Pos('PRN', x) > 0 then
     1853        begin
     1854         NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
     1855         chkPRN.Checked := True;
     1856         cboSchedule.SelectByID(NonPRNPart);
     1857         if cboSchedule.ItemIndex > -1 then  EXIT;
     1858         cboSchedule.Items.Add(NonPRNPart);
     1859         cboSchedule.Text := NonPRNPart;
     1860         cboSchedule.SelectByID(NonPRNPart);
     1861         EXIT;
     1862        end;
     1863         cboSchedule.Items.Add(x);
     1864         cboSchedule.Text := x;
     1865         cboSchedule.SelectByID(x);
    17781866      end;
    1779     end;
    17801867  end;
    17811868end;
    17821869
    17831870{ Medication edit --------------------------------------------------------------------------- }
    1784 
    17851871procedure TfrmODMeds.tabDoseChange(Sender: TObject);
    17861872var
    1787   x: string;
    1788 
    1789 begin
    1790   inherited;
     1873  //text,x, tmpsch: string;
     1874  text, x: string;
     1875  reset: integer;
     1876begin
     1877  inherited;
     1878  reset := 0;
     1879  //AGP change for CQ 6521 added warning message
     1880  //AGP Change for CQ 7508 added tab information
     1881  //GE  Change warning message functionality show only   cq 7590
     1882  //    when tab changes from complex to simple.
     1883  //AGP Change for CQ 7834 and 7832 change text and added check to see if some values have been completed in row 1
     1884  if (tabDose.TabIndex = 0) and ((ValFor(COL_DOSAGE, 1)<>'') or (ValFor(COL_SCHEDULE, 1)<>'') or (ValFor(COL_DURATION, 1)<>'') or
     1885      (ValFor(COL_SEQUENCE, 1)<>''))  then
     1886      begin
     1887        text := 'By switching to the Dosage Tab, ' ;
     1888         if (InfoBox(text +'you will lose all data on this screen. Click “OK” to continue or “Cancel”','Warning',MB_OKCANCEL)=IDCANCEL) then
     1889            begin
     1890             if tabDose.TabIndex = 1 then tabDose.TabIndex := 0
     1891             else tabDose.TabIndex := 1;
     1892             reset := 1;
     1893            end;
     1894      end;
    17911895  case tabDose.TabIndex of
    17921896  TI_DOSE:    begin
     1897                cboXSchedule.Clear;                       // Added to Fix CQ: 9603
    17931898                // clean up responses?
    17941899                FSuppressMsg := FOrigiMsgDisp;
    17951900                ShowControlsSimple;
    1796                 ResetOnTabChange;
     1901                if reset = 0 then ResetOnTabChange;
     1902                txtNss.Left := lblSchedule.Left + lblSchedule.Width + 2;
    17971903                if (FInptDlg) then txtNss.Visible := True
    17981904                else txtNss.Visible := False;
    … …  
    18051911  TI_COMPLEX: begin
    18061912                FSuppressMsg := FOrigiMsgDisp;
     1913                if reset = 1 then exit;
    18071914                ShowControlsComplex;
    18081915                ResetOnTabChange;
     1916                txtNss.Left := grdDoses.Left + grdDoses.ColWidths[0] + grdDoses.ColWidths[1] + grdDoses.ColWidths[2] + 3;
    18091917                txtNss.Visible := False;
    1810                 if txtNss.Visible then txtNss.Visible := False;           
    18111918                x := cboXDosage.Text + TAB;
    18121919                with cboXDosage   do if ItemIndex > -1 then x := x + Items[ItemIndex];
    … …  
    18181925                with cboXSchedule do if ItemIndex > -1 then x := x + Items[ItemIndex];
    18191926                grdDoses.Cells[COL_SCHEDULE, 1] := x;
     1927                UpdateStartExpires(ValFor(VAL_SCHEDULE,1));
    18201928                ControlChange(Self);
    18211929             end; {TI_COMPLEX}
    18221930  end; {case}
    18231931end;
     1932
    18241933
    18251934procedure TfrmODMeds.lblGuidelineClick(Sender: TObject);
    … …  
    19012010
    19022011procedure TfrmODMeds.cboDosageChange(Sender: TObject);
    1903 var
    1904   tmpIdx: integer;
    1905   tmpTxt,tmpTxt1: string;
    1906 begin
    1907   inherited;
    1908   //if length(cboDosage.Text) < 1 then
    1909   //  cboDosage.ItemIndex := -1;
     2012begin
     2013  inherited;
    19102014  UpdateRelated;
    19112015end;
    … …  
    19462050begin
    19472051  inherited;
    1948 //if cboRoute.Text = '' then
    1949 //  cboRoute.ItemIndex := -1;
    19502052  with cboRoute do
    19512053    if ItemIndex > -1 then
    … …  
    19942096begin
    19952097  inherited;
    1996   if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
     2098  if  (FInptDlg) and (cboSchedule.Text = 'OTHER') then
    19972099  begin
    19982100    othSch := CreateOtherScheduel;
    … …  
    20042106    end;
    20052107  end;
    2006 //if cboSchedule.Text = '' then
    2007 //  cboSchedule.ItemIndex := -1;
    20082108//Remove Deletion of Text, since we are changing the validation to be on exit of the control.
    20092109{  if (Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0) and FInptDlg then
    … …  
    21162216      if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM);
    21172217      Schedule := ValueOf(FLD_SCHED_EX);
    2118       if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE);
     2218      (* Schedule := Piece(Temp,U,1);
     2219      if Piece(Temp,U,3) = '1' then Schedule := Schedule + ' AS NEEDED';
     2220      if UpperCase(Copy(Schedule, Length(Schedule) - 18, Length(Schedule))) = 'AS NEEDED AS NEEDED'
     2221      then Schedule := Copy(Schedule, 1, Length(Schedule) - 10); *)
     2222      if Length(Schedule) = 0 then
     2223        begin
     2224          Schedule := ValueOf(FLD_SCHEDULE);
     2225          if RightStr(Schedule,3) = 'PRN' then
     2226             begin
     2227               Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN
     2228               if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then
     2229               Schedule := Copy(Schedule,1,Length(Schedule)-1);
     2230               Schedule := Schedule + ' AS NEEDED'
     2231             end;
     2232        end;
    21192233      Result := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule;
    21202234    end;
    … …  
    21402254        if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM, i);
    21412255        Schedule := ValueOf(FLD_SCHED_EX, i);
    2142         if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE, i);
     2256        //if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE, i);
     2257        if Length(Schedule) = 0 then
     2258        begin
     2259          Schedule := ValueOf(FLD_SCHEDULE);
     2260          if RightStr(Schedule,3) = 'PRN' then
     2261             begin
     2262               Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN
     2263               if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then
     2264               Schedule := Copy(Schedule,1,Length(Schedule)-1);
     2265               Schedule := Schedule + ' AS NEEDED'
     2266             end;
     2267        end;
    21432268        Duration := ValueOf(FLD_DURATION, i);
    21442269        if Length(Duration) > 0 then Duration := 'FOR ' + Duration;
    … …  
    22412366begin
    22422367  Result := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 4);
    2243   if (not FInptDlg) and (Length(FDrugID) > 0) then
     2368  //AGP CHANGE 26.33 change for Remedy ticket 87476 fix for quick orders for complex
     2369  //inpatient orders not displaying the correct unit dose in Pharmacy
     2370  //if (not FInptDlg) and (Length(FDrugID) > 0) then
     2371  if Length(FDrugID) > 0 then
    22442372  begin
    22452373    Result := '';
    … …  
    24542582  TI_COMPLEX:
    24552583    begin
    2456       if txtNss.Visible then txtNss.Visible := False;
     2584      //if txtNss.Visible then txtNss.Visible := False;
    24572585      with grdDoses do for i := 1 to Pred(RowCount) do
    24582586      begin
    … …  
    24912619                                   else Responses.Update('ROUTE',    i, '', x);
    24922620        x := ValueOf(FLD_SCHEDULE, i);  Responses.Update('SCHEDULE', i, x, x);
     2621        if FSmplPRNChkd then   // GE CQ7585  Carry PRN checked from simple to complex tab
     2622        begin
     2623           pnlXSchedule.Tag := 1;
     2624           chkXPRN.Checked := True;
     2625          //cboXScheduleClick(Self);// force onclick to fire when complex tab is entered
     2626           FSmplPRNChkd := False;
     2627        end;
    24932628        x := ValueOf(FLD_DURATION, i);  Responses.Update('DAYS',     i, UpperCase(x), x);
    24942629        x := ValueOf(FLD_SEQUENCE, i);
    … …  
    25082643  begin
    25092644    Responses.Update('NOW',     1, ValueOf(FLD_NOW_ID), ValueOf(FLD_NOW_NM));
    2510     x := InpatientSig;                  Responses.Update('SIG',     1, TX_WPTYPE, x);
     2645    x := InpatientSig;
     2646    Responses.Update('SIG',     1, TX_WPTYPE, x);
    25112647  end else                                        // outpatient orders
    25122648  begin
    … …  
    25482684    VAL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
    25492685    VAL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
     2686    VAL_CHKXPRN  : Result := Cells[COL_CHKXPRN, ARow];
    25502687    end;
    25512688end;
    … …  
    27292866procedure TfrmODMeds.ShowEditor(ACol, ARow: Integer; AChar: Char);
    27302867var
    2731   x, NonPRNPart: string;
     2868  x,tmpText: string;
    27322869
    27332870  procedure PlaceControl(AControl: TWinControl);
    … …  
    27592896begin
    27602897  inherited;
     2898  txtNSS.Visible := False;
    27612899  //Make space just select editor.  This blows up as soon as some joker makes a
    27622900  //dosage starting with a space.
    … …  
    27842922                      //grdDoses.Cells[COL_SCHEDULE, ARow] := grdDoses.Cells[COL_SCHEDULE, Pred(ARow)];
    27852923                    end;
    2786                     if grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] = '' then
     2924                //AGP Change 26.45 remove auto-populate of the sequence field
     2925                {*    if grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] = '' then
    27872926                    begin
    27882927                      if StrToIntDef(Piece(grdDoses.Cells[COL_DURATION, Pred(ARow)], ' ', 1), 0) > 0
    27892928                        then grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] := 'THEN'
    27902929                        else grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] := 'AND';
    2791                     end;
     2930                    end;  *}
    27922931                  end;
    27932932                  // set appropriate value for cboDosage
    … …  
    28062945  COL_SCHEDULE: begin
    28072946                  // set appropriate value for cboSchedule
     2947                  if FInptDlg then txtNSS.Visible := True;
    28082948                  x := Piece(grdDoses.Cells[COL_SCHEDULE, ARow], TAB, 1);
    28092949                  Changing := TRUE;
    2810                   chkXPRN.Checked := False;
     2950                  if ValFor(VAL_CHKXPRN,Arow)='1' then chkXPRN.Checked := true
     2951                  else chkXPRN.Checked := False;
     2952                  if Pos('PRN',x)>0 then
     2953                    begin
     2954                      cboXSchedule.SelectByID(x);
     2955                      if cboXSchedule.ItemIndex <0 then
     2956                        begin
     2957                          x := Trim(Copy(x, 1, Pos('PRN', x) - 1));
     2958                          chkXPRN.Checked := true;
     2959                        end;
     2960                    end;
    28112961                  if Length(x) > 0 then
    28122962                  begin
    … …  
    28152965                  end
    28162966                  else cboXSchedule.ItemIndex := -1;
    2817                   if Pos('PRN', x) > 0 then
     2967                (*  if Pos('PRN', x) > 0 then
    28182968                  begin
    28192969                    NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
    … …  
    28252975                      if cboXSchedule.ItemIndex < 0 then cboXSchedule.Text := x;
    28262976                    end;
    2827                   end;
     2977                  end; *)
    28282978                  Changing := FALSE;
    28292979                  pnlXSequence.Tag := ARow;
    … …  
    28442994                    btnXDuration.Caption := 'days';
    28452995                  end;
     2996                  tmpText := txtXDuration.Text;  //Fix for CQ: 8107 - Kloogy but works.
    28462997                  UpdateDurationControls(False);
    2847 
    28482998                  Changing := FALSE;
    28492999                  pnlXDuration.Tag := ARow;
    28503000                  PlaceControl(pnlXDuration);
    28513001                  txtXDuration.SetFocus;
     3002                  ARow1 := ARow;
     3003                  txtXDuration.Text := tmpText;  //Fix for CQ: 8107 - Kloogy but works.
    28523004                  if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_DURATION);
    28533005                end;
    28543006  COL_SEQUENCE: begin
    28553007                  x := ValFor(COL_SEQUENCE, ARow);
    2856                   if x = '' then x := 'then';
     3008                  //if x = '' then x := 'and';  AGP Change 26.46 remove for CQ 9535
    28573009                  btnXSequence.Caption := x;
    28583010                  pnlXSequence.Caption := btnXSequence.Caption;
    28593011                  pnlXSequence.Tag := ARow;
     3012                  ARow1 := ARow;
    28603013                  PlaceControl(pnlXSequence);
    2861                   btnXSequence.Width := pnlXSequence.Width;                 
     3014                  btnXSequence.Width := pnlXSequence.Width;
    28623015                end;
    28633016  end; {case ACol}
    … …  
    29293082    then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
    29303083    else lblQtyMsg.Caption := '';
    2931 
    29323084end;
    29333085
    … …  
    29853137    cboXRoute.ItemIndex := -1;
    29863138    Exit;
    2987   end;
     3139  end; 
    29883140  cboXRouteClick(Self);
    29893141  cboXRoute.Tag := -1;
    … …  
    30133165procedure TfrmODMeds.cboXScheduleChange(Sender: TObject);
    30143166var
    3015   othSch, x, PRN: string;
     3167  othSch, x: string;
    30163168  idx : integer;
    30173169begin
    … …  
    30313183      end;
    30323184    end;
    3033     if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
     3185  (* if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
    30343186    with cboXSchedule do if ItemIndex > -1
    30353187      then x := Text + PRN + TAB + Items[ItemIndex]
    3036       else x := Text + PRN;
     3188      else x := Text + PRN; *)
     3189    with cboXSchedule do if ItemIndex > -1
     3190      then x := Text + TAB + Items[ItemIndex]
     3191      else x := Text;
    30373192    grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
     3193    self.cboSchedule.Text := x;
    30383194    UpdateRelated;
    30393195  end;
    … …  
    30423198procedure TfrmODMeds.cboXScheduleClick(Sender: TObject);
    30433199var
    3044   x, PRN: string;
    3045 begin
    3046   inherited;
    3047   if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
     3200  x: string;
     3201begin
     3202  inherited;
     3203  //if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
     3204 (* with cboXSchedule do if ItemIndex > -1
     3205    then x := Text + PRN + TAB + Items[ItemIndex]
     3206    else x := Text + PRN;  *)
    30483207  with cboXSchedule do if ItemIndex > -1
    3049     then x := Text + PRN + TAB + Items[ItemIndex]
    3050     else x := Text + PRN;
    3051   if (Pos('PRN',X)>0) and (pnlXSchedule.Tag = 1) then
     3208    then x := Text + TAB + Items[ItemIndex]
     3209    else x := Text;
     3210   (* if (Pos('PRN',X)>0) and (pnlXSchedule.Tag = 1) then
    30523211    if lblAdmintime.visible then
    3053       lblAdmintime.Caption := '';
     3212      lblAdmintime.Caption := ''; *)
    30543213  grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
     3214  UpdateStartExpires(x);
    30553215  UpdateRelated;
    30563216end;
    30573217
    30583218procedure TfrmODMeds.chkXPRNClick(Sender: TObject);
    3059 begin
    3060   inherited;
     3219var
     3220check: string;
     3221begin
     3222  inherited;
     3223  if self.chkXPRN.Checked = True then check := '1'
     3224  else check := '0';
     3225  self.grdDoses.Cells[COL_CHKXPRN, self.grdDoses.Row] := check;
    30613226  if not Changing then cboXScheduleClick(Self);
    30623227end;
    … …  
    30963261var
    30973262  I, Code: Integer;
     3263  OrgValue: string;
    30983264begin
    30993265  inherited;
    … …  
    31033269    Val(txtXDuration.Text, I, Code);
    31043270    UpdateDurationControls(Code <> 0);
    3105     if (Code <> 0) and (I=0) then
    3106     begin
    3107       ShowMessage('Free text input is not allowed!');
    3108       txtXDuration.Text := '0';
     3271    //Commented out the "and" to resolve CQ: 7557
     3272    if (Code <> 0) {and (I=0)} then
     3273    begin
     3274      ShowMessage('Please use numeric characters only.');
     3275      with txtXDuration do
     3276      begin
     3277        Text := IntToStr(I);
     3278        SelStart := Length(Text);
     3279      end;
    31093280      Exit;
    31103281      btnXDuration.Width := 8;
    … …  
    31143285      PopDuration.Items.Tag := 0;
    31153286      btnXDuration.Caption := '';
    3116     end
     3287    end;
     3288   {AGP change 26.19 for PSI-05-018 cq #7322
    31173289    else if PopDuration.Items.Tag = 0 then
    31183290    begin
    31193291      PopDuration.Items.Tag := 3;  //Days selection
    31203292      btnXDuration.Caption := 'days';
    3121     end;
     3293    end; }
    31223294    grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := txtXDuration.Text + ' ' + Uppercase(btnXDuration.Caption);
    3123   end else grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
     3295  end else   //AGP CHANGE ORDER
     3296       begin
     3297         if not(FInptDlg) then grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
     3298         OrgValue := ValFor(COL_DURATION, pnlxDuration.tag);
     3299         //if ((txtXDuration.Text = '0') or (txtXDuration.Text = '')) and ((ValFor(COL_SEQUENCE, ARow1) = 'THEN') and (FInptDlg)) then //AGP CHANGE ORDER
     3300         //AGP change 26.33 Then/And conjunction requiring a duration to include outpatient orders also
     3301         if ((txtXDuration.Text = '0') or (txtXDuration.Text = '')) and (ValFor(COL_SEQUENCE, ARow1) = 'THEN') then //AGP CHANGE ORDER
     3302             begin
     3303               if (InfoBox('A duration is required when using "Then" as a sequence.'+CRLF+'"Then" will be remove from the sequence field if you continue'+
     3304                    CRLF+'Click "OK" to continue or click "Cancel"','Duration Warning', MB_OKCANCEL)=1) then
     3305                    begin
     3306                        grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
     3307                        pnlXSequence.Tag := ARow1;
     3308                        pnlXSequence.Caption := '';
     3309                        grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := '';
     3310                        btnXSequence.Click;
     3311                    end
     3312                    else
     3313                    grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := OrgValue;
     3314               end
     3315             else grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := txtXDuration.Text;
     3316       end;
     3317   // end;
    31243318  ControlChange(Self);
    31253319  UpdateRelated;
    … …  
    31513345begin
    31523346  inherited;
     3347  inherited;
    31533348  with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
    31543349  popXSequence.Popup(APoint.X, APoint.Y);
    31553350  pnlXSequence.Caption := btnXSequence.Caption;
     3351  {
     3352  with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
     3353  popXSequence.Popup(APoint.X, APoint.Y);
     3354  pnlXSequence.Caption := btnXSequence.Caption;
     3355  if (pnlXSequence.Caption = 'then') and
     3356      ((ValFor(COL_DURATION, ARow1) = '') or
     3357       (ValFor(COL_DURATION, ARow1) = '0')) then
     3358     begin
     3359       InfoBox('A duration is required when using "Then" as a conjunction','Duration Warning',MB_OK);
     3360       pnlXSequence.Caption := '';
     3361       btnXSequence.Caption := '';
     3362     end;
     3363     }
    31563364end;
    31573365
    … …  
    31623370  inherited;
    31633371  with TMenuItem(Sender) do if Tag > 0 then x := Caption else x := '';
     3372 //AGP Changes 26.12 PSI-04-63
     3373 //if ((x = 'then') and (FInptDlg)) and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
     3374 //AGP change 26.32 Then/And conjunction requiring a duration to include outpatient orders
     3375 if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
     3376     begin
     3377       InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+
     3378           'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK);
     3379       x := '';
     3380     end;
    31643381  btnXSequence.Caption := x;
    31653382  pnlXSequence.Caption := btnXSequence.Caption;
    … …  
    32793496    FLD_ROUTE_EX  : with cboRoute do
    32803497                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
    3281     FLD_SCHEDULE  : begin
     3498    FLD_SCHEDULE  : begin        //gary)
    32823499                      Result := UpperCase(Trim(cboSchedule.Text));
    32833500                      if chkPRN.Checked then Result := Result + ' PRN';
    … …  
    32873504    FLD_SCHED_EX  : begin
    32883505                      with cboSchedule do
     3506                        begin
    32893507                        if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
     3508                   (*     if (Length(Result)=0) and (ItemIndex > -1) then
     3509                            begin
     3510                              Result := Piece(Items[ItemIndex], U, 1);
     3511                              if Piece(Items[ItemIndex], U, 3) = 'P' then
     3512                              begin
     3513                                if RightStr(Result,3) = 'PRN' then
     3514                                  begin
     3515                                    Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
     3516                                    if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
     3517                                    Result := Copy(Result,1,Length(Result)-1);
     3518                                  end;
     3519                               Result := Result + ' AS NEEDED';
     3520                              end;
     3521                            end;
     3522                        end; *)
     3523                      if RightStr(Result,3) = 'PRN' then
     3524                           begin
     3525                              Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
     3526                              if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
     3527                              Result := Copy(Result,1,Length(Result)-1);
     3528                              Result := Result + ' AS NEEDED'
     3529                           end;
    32903530                      if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
    32913531                      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
    32923532                        then Result := Copy(Result, 1, Length(Result) - 10);
     3533                      if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
     3534                          begin
     3535                            Result := Copy(Result, 1, Length(Result) - 13);
     3536                            if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
     3537                            else Result := Result + ' AS NEEDED';
     3538                          end;
     3539                    end;
    32933540                    end;
    32943541    FLD_SCHED_TYP : with cboSchedule do
    … …  
    33303577      FLD_ROUTE_AB  : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 3);
    33313578      FLD_ROUTE_EX  : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 4);
    3332       FLD_SCHEDULE  : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
     3579      FLD_SCHEDULE  : begin
     3580                         Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1);
     3581                         if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
     3582                         if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN';
     3583                         if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then
     3584                         Result := Copy(Result, 1, Length(Result) - 4);
     3585                      end;
    33333586      FLD_SCHED_EX  : begin
    3334                         Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2);
     3587                        (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2);
    33353588                        if Result = '' then //Added for CQ: 7639
    33363589                        begin
    … …  
    33433596                           (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0)
    33443597                           then Result := Result + ' AS NEEDED';
     3598                      end;*)
     3599                        Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2);
     3600                        if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639
     3601                        if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
     3602                        if RightStr(Result,3) = 'PRN' then
     3603                           begin
     3604                              Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
     3605                              if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
     3606                              Result := Copy(Result,1,Length(Result)-1);
     3607                              Result := Result + ' AS NEEDED';
     3608                           end;
     3609                        if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED';
     3610                        if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
     3611                        then Result := Copy(Result, 1, Length(Result) - 10);
     3612                        if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
     3613                          begin
     3614                            Result := Copy(Result, 1, Length(Result) - 13);
     3615                            if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
     3616                            else Result := Result + ' AS NEEDED';
     3617                          end;
    33453618                      end;
    33463619      FLD_SCHED_TYP : Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 3);
    … …  
    35523825procedure TfrmODMeds.UpdateStartExpires(const CurSchedule: string);
    35533826var
    3554   ShowText, Duration, ASchedule: string;
     3827  CompSch, ShowText, Duration, ASchedule: string;
    35553828  AdminTime:    TFMDateTime;
    3556   Interval, PrnPos: Integer;
     3829  i, j, Interval, PrnPos: Integer;
    35573830begin
    35583831  if Length(CurSchedule)=0 then Exit;
    35593832  ASchedule := Trim(CurSchedule);
    3560   if (Pos('^',ASchedule)=0) then
    3561   begin
    3562     PrnPos := Pos('PRN',ASchedule);
    3563     if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1) <> ';') then
    3564       Delete(ASchedule, PrnPos, Length(ASchedule));
    3565   end
    3566   else if (Pos('^',ASchedule)>0) then
     3833  if (Pos('^',ASchedule)>0) then
    35673834  begin
    35683835    PrnPos := Pos('PRN',ASchedule);
    … …  
    35713838  end;
    35723839  ASchedule := Trim(ASchedule);
     3840  if self.tabDose.TabIndex = TI_COMPLEX then
     3841    begin
     3842      CompSch := valFor(VAL_SCHEDULE,1);
     3843      if CompSch = '' then
     3844        begin
     3845          ASchedule := '';
     3846          AdminTime := -1;
     3847        end;
     3848      if CompSch <> '' then
     3849        begin
     3850          for i := 0 to self.cboXSchedule.Items.Count-1 do
     3851            begin
     3852              if (Piece(self.cboXSchedule.Items.Strings[i],U,1) = CompSch) and (Piece(self.cboXSchedule.Items.Strings[i],U,3)='P') then
     3853                begin
     3854                  AdminTime := -1;
     3855                  Aschedule := '';
     3856                end;
     3857            end;
     3858        end;
     3859        if valFor(VAL_CHKXPRN,1)='1' then
     3860          begin
     3861            AdminTime := -1;
     3862            Aschedule := '';
     3863          end;
     3864      if (ASchedule <> '') and (CompSch <> '') then ASchedule := ';' + CompSch;
     3865    end;
    35733866  if Length(ASchedule)>0 then
    3574       LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration)
    3575   else Exit;
     3867      LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration);
     3868  //else Exit;
     3869  if (AdminTime > 0) and (self.tabDose.TabIndex = TI_DOSE) then
     3870    begin
     3871     if self.cboSchedule.ItemIndex = -1 then
     3872       begin
     3873         for j := 0 to self.cboSchedule.items.Count -1 do
     3874           begin
     3875             if (Piece(self.cboSchedule.Items.Strings[j],U,1) = Piece(Aschedule,';',2)) and (Piece(self.cboSchedule.Items.Strings[j],U,3)='P') then
     3876               begin
     3877                 AdminTime := -1;
     3878                 break;
     3879               end;
     3880           end;
     3881       end;
     3882     if (self.cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.ItemIndex],U,3)='P') then
     3883       AdminTime := -1;
     3884     if self.chkPRN.Checked = true then AdminTime := -1
     3885    end;
    35763886  if AdminTime > 0 then
    35773887  begin
    … …  
    36303940  CurSupply, i, pNum, j: Integer;
    36313941  CurQuantity: double;
    3632   LackQtyInfo, SaveChanging: Boolean;
     3942  LackQtyInfo, SaveChanging, DispFirstDose: Boolean;
    36333943begin
    36343944  inherited;
    … …  
    36373947  SaveChanging := Changing;
    36383948  Changing := TRUE;
     3949  DispFirstDose := FALSE;
    36393950  // don't allow Exit procedure so Changing gets reset appropriately
    36403951  CurUnits    := '';
    … …  
    37004011      or ((Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0)) then
    37014012    begin
    3702         if (chkDoseNow.Checked) and (chkDoseNow.Visible) then
     4013      if (chkDoseNow.Checked) and (chkDoseNow.Visible) then
     4014      begin
     4015        chkDoseNowClick(Self);
     4016        chkDoseNow.Checked := False;
     4017      end;
     4018      for i := 0 to cboSchedule.Items.Count-1 do
    37034019        begin
    3704           chkDoseNowClick(Self);
    3705           chkDoseNow.Checked := False;
     4020                  if Piece(cboSchedule.Items.Strings[i],U,1) = Uppercase(cboSchedule.Text) then
     4021            begin
     4022              DispFirstDose := True;
     4023              break;
     4024            end;
    37064025        end;
    3707         chkDoseNow.Visible := False;
    3708         lblAdminTime.Visible := False;
     4026      if not DispFirstDose then
     4027        begin
     4028          chkDoseNow.Visible := False;
     4029          lblAdminTime.Visible := False;
     4030        end;
    37094031    end
    37104032    else
    … …  
    37154037    if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
    37164038  end;
    3717   if not FInptDlg then
     4039    if not FInptDlg then
    37184040  begin
    37194041    CurSchedule := CurScheduleOut;
    3720     if CurInstruct <> FLastInstruct
     4042    if (CurInstruct <> FLastInstruct) and (CurUnits <> U) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server
    37214043      then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity,
    37224044                               LackQtyInfo);
    … …  
    37514073
    37524074procedure TfrmODMeds.cmdAcceptClick(Sender: TObject);
    3753 begin
    3754   if (cboSchedule.Text = 'OTHER') and (FInptDlg)then
     4075var
     4076i: integer;
     4077begin
     4078  if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
    37554079  begin
    37564080    cboScheduleClick(Self);
    37574081    Exit;
    37584082  end;
     4083  //AGP Change for 26.45 PSI-04-069
     4084  if self.tabDose.TabIndex = 1 then
     4085    begin
     4086       for i := 2 to self.grdDoses.RowCount do
     4087         begin
     4088           if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
     4089             begin
     4090              infoBox('To be able to complete a complex order every row except for the last row must have a conjunction defined. ' + CRLF
     4091              + CRLF + 'Verify that all rows have a conjunction defined.','Sequence Error',MB_OK);
     4092              Exit;
     4093             end;
     4094           //text := Self.cboXDosage.Items.Strings[i];
     4095         end;
     4096    end;
    37594097  if FInptDlg and (not FOutptIV)
    37604098    then DisplayGroup := DisplayGroupByName('UD RX')
    37614099  else DisplayGroup := DisplayGroupByName('O RX');
     4100  //timCheckChangesTimer(Self);
    37624101  DropLastSequence;
    37634102  cmdAccept.SetFocus;
    37644103  inherited;
     4104  (*if self.Responses.Cancel = true then
     4105    begin
     4106      self.Destroy;
     4107      exit;
     4108    end; *)
    37654109end;
    37664110
    … …  
    37914135    if length(theSch)>0 then
    37924136    begin
    3793       if (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) then
     4137      if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then
    37944138      begin
    37954139        chkDoseNow.Checked := False;
    … …  
    38084152  if (tabDose.TabIndex = TI_COMPLEX) and chkDoseNow.Checked  then
    38094153  begin
    3810     if (ValueOf(FLD_SCHED_TYP) <> 'O') and ( InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF +
     4154    if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF +
    38114155                 'Please adjust the duration of the first row, if necessary.',
    3812                  'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) then
     4156                 'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) ) then
    38134157    begin
    38144158      chkDoseNow.Checked := False;
    … …  
    39084252var
    39094253  tempSch: string;
    3910 begin
    3911   inherited;
    3912   if chkPRN.Checked then lblAdminTime.Caption := ''
     4254  PRNPos: integer;
     4255begin
     4256  inherited;
     4257  //GE  CQ 7552
     4258  if chkPRN.Checked then
     4259  begin
     4260     lblAdminTime.Caption := '';
     4261     PrnPos := Pos('PRN',cboSchedule.Text);
     4262     if (PrnPos < 1) then
     4263        UpdateStartExpires(cboSchedule.Text + ' PRN');
     4264  end
    39134265  else
    39144266  begin
    … …  
    39184270      UpdateStartExpires(tempSch);
    39194271    end;
    3920     lblAdminTime.Caption := FAdminTimeLbl;
     4272    //lblAdminTime.Caption := FAdminTimeLbl;
    39214273    if txtQuantity.visible then
    39224274      cboScheduleClick(Self);
    … …  
    40314383  end
    40324384  else if (Key = #13) and (ActiveControl = txtMed) then
    4033     Key := #0   //Don't let the base class turn it into a forward tab!
    4034   else
    4035     inherited;
     4385    Key := #0;   //Don't let the base class turn it into a forward tab!
    40364386end;
    40374387
    … …  
    42844634  inherited;
    42854635  if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list'
    4286     + ' to create a day-of-week or admin-time only schedule.'
     4636    + ' to create a day-of-week schedule.'
    42874637    + #13#10 + 'Click OK to launch schedule builder',
    42884638    mtInformation, [mbOK, mbCancel],0) = mrOK then
    … …  
    42924642      cboSchedule.SelectByID('OTHER');
    42934643      cboScheduleClick(Self);
     4644    end;
     4645    if  (tabDose.TabIndex = TI_COMPLEX) then
     4646    begin
     4647      cboXSchedule.SelectByID('OTHER');
     4648      CBOXScheduleChange(Self);
    42944649    end;
    42954650  end;
    … …  
    43254680
    43264681procedure TfrmODMeds.ValidateInpatientSchedule(ScheduleCombo: TORComboBox);
    4327 begin
    4328   //CQ 7575  Schedule coming across lower-case, change all schedules to Upper-Case.
     4682var
     4683  tmpIndex : Integer;
     4684begin
     4685
     4686{CQ: 6690 - Orders - autopopulation of schedule field - overtyping only 1 character
     4687 CQ: 7280 - PTM 32-34, 42 Meds: NJH-0205-20901 MED DIALOG DROPPING FIRST LETTER (schedule)}
     4688
     4689 //CQ 7575  Schedule coming across lower-case, change all schedules to Upper-Case.
    43294690  if (Length(ScheduleCombo.Text) > 0) then
    4330      ScheduleCombo.Text := UpperCase(ScheduleCombo.Text);
     4691    ScheduleCombo.Text := TrimLeft(UpperCase(ScheduleCombo.Text));
     4692    {if user entered schedule verify it is in list}
     4693  if ScheduleCombo.ItemIndex < 0 then // CQ: 7397
     4694  begin //Fix for CQ: 9299 - Outpatient Med orders will not accept free text schedule
     4695    tmpIndex := GetSchedListIndex(ScheduleCombo,ScheduleCombo.Text);
     4696    if tmpIndex > -1 then
     4697      ScheduleCombo.ItemIndex := tmpIndex;
     4698  end;
    43314699  if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then
    43324700  begin
    43334701    FShowPnlXScheduleOk := False; //Added for CQ: 7370
    43344702    Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+
    4335                            'If you would like to create a non-standard schedule please'+
     4703                           'If you would like to create a Day-of-Week schedule please'+
    43364704                           ' select ''OTHER'' from the list.',
    43374705                           'Incorrect Schedule.');
    … …  
    43444712
    43454713//Removed based on Site feeback. See CQ: 7518
    4346 {function TfrmODMeds.ValidateRoute(RouteCombo: TORComboBox) : Boolean;
    4347 begin
     4714(*function TfrmODMeds.ValidateRoute(RouteCombo: TORComboBox) : Boolean;
     4715begin
     4716{CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window}
    43484717  Result := True;
    43494718  if (Length(RouteCombo.Text) > 0) and (RouteCombo.ItemIndex < 0) and (Not IsSupplyAndOutPatient) then
    … …  
    43564725    Result := False;
    43574726  end;
    4358 end;}
     4727end;*)
    43594728
    43604729function TfrmODMeds.isUniqueQuickOrder(iText: string): Boolean;
    … …  
    43734742function TfrmODMeds.IsSupplyAndOutPatient: boolean;
    43744743begin
     4744{CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window}
    43754745  Result := False;
    43764746  if (MedIsSupply(txtMed.Tag)) and (not FInptDlg) then
    … …  
    43784748end;
    43794749
     4750// CQ: 7397 - Inpatient med orders with PRN cancel due to invalid schedule.
     4751function TfrmODMeds.GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
     4752var i: integer;
     4753begin
     4754    result := -1;
     4755    for i := 0 to SchedCombo.items.Count-1 do
     4756    begin
     4757         if pSchedule = SchedCombo.DisplayText[i] then
     4758         begin
     4759           result := i;   // match found
     4760           break;
     4761         end;
     4762    end;
     4763end;
     4764
    43804765
    43814766procedure TfrmODMeds.cboXScheduleExit(Sender: TObject);
    43824767begin
    43834768  inherited;
     4769{CQ: 7344 - Inconsistency with Schedule box: Allows free-text entry for Complex orders,
     4770            doesn't for simple orders }
    43844771  ValidateInpatientSchedule(cboXSchedule);
    43854772end;
    43864773
     4774procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word;
     4775  Shift: TShiftState);
     4776begin
     4777  inherited;
     4778  //Fix for CQ: 7545
     4779  if cboDosage.ItemIndex > -1 then
     4780    cboDosageClick(Sender);
     4781end;
     4782
     4783procedure TfrmODMeds.cboXDosageKeyUp(Sender: TObject; var Key: Word;
     4784  Shift: TShiftState);
     4785begin
     4786  inherited;
     4787  //Fix for CQ: 7545
     4788  if cboXDosage.ItemIndex > -1 then
     4789    cboXDosageClick(Sender);
     4790end;
     4791
     4792procedure TfrmODMeds.txtSupplyClick(Sender: TObject);
     4793begin
     4794  inherited;
     4795  Self.txtSupply.SelectAll;
     4796end;
     4797
     4798procedure TfrmODMeds.txtQuantityClick(Sender: TObject);
     4799begin
     4800  inherited;
     4801   self.txtQuantity.SelectAll;
     4802end;
     4803
     4804procedure TfrmODMeds.txtRefillsClick(Sender: TObject);
     4805begin
     4806  inherited;
     4807  self.txtRefills.SelectAll;
     4808end;
     4809
     4810procedure TfrmODMeds.WMClose(var Msg: TWMClose);
     4811begin
     4812   if self <> nil then
     4813     begin
     4814       if (self.tabDose.TabIndex = TI_Dose) then
     4815         begin
     4816            if Trim(cboSchedule.Text) = '' then cboSchedule.ItemIndex := -1;
     4817            ValidateInpatientSchedule(cboSchedule);
     4818            if self.cboSchedule.Focused = true then exit;
     4819         end;
     4820       if (self.tabDose.TabIndex = TI_Complex) then
     4821         begin
     4822           ValidateInpatientSchedule(cboXSchedule);
     4823           if self.cboXSchedule.Focused = true then exit;
     4824         end;
     4825     end;
     4826    inherited
     4827end;
     4828
     4829procedure TfrmODMeds.cboXScheduleEnter(Sender: TObject);
     4830begin
     4831  inherited;
     4832  //agp Change CQ 10719
     4833   self.chkXPRN.OnClick(self.chkXPRN);
     4834end;
     4835
    43874836end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODRad.dfm

    r459 r460  
    88  Constraints.MinHeight = 344
    99  Constraints.MinWidth = 576
    10   OnPaint = FormPaint
    1110  PixelsPerInch = 96
    1211  TextHeight = 13
    … …  
    8887      SynonymChars = '<>'
    8988      TabOrder = 0
    90       OnDropDownClose = cboImTypeChange
     89      OnChange = cboImTypeChange
     90      OnDropDownClose = cboImTypeDropDownClose
    9191      OnExit = cboImTypeExit
    9292      CharsNeedMatch = 1
    … …  
    241241      TabOrder = 8
    242242      OnChange = calPreOpChange
     243      OnExit = calPreOpExit
    243244      DateOnly = False
    244245      RequireTime = False
    … …  
    256257      TabOrder = 6
    257258      OnClick = ControlChange
     259      OnExit = chkIsolationExit
    258260    end
    259261    object calRequestDate: TORDateBox

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODRad.pas

    r459 r460  
    5656    procedure FormCreate(Sender: TObject);
    5757    procedure cboImTypeChange(Sender: TObject);
    58     procedure FormPaint(Sender: TObject);
    5958    procedure memReasonExit(Sender: TObject);
    6059    procedure FormResize(Sender: TObject);
    … …  
    6564    procedure cboProcedureExit(Sender: TObject);
    6665    procedure cboImTypeExit(Sender: TObject);
     66    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     67    procedure chkIsolationExit(Sender: TObject);
     68    procedure calPreOpExit(Sender: TObject);
     69    procedure cboImTypeDropDownClose(Sender: TObject);
    6770  private
    6871    FLastRadID: string;
    … …  
    7174    FEvtDelayDiv: string;
    7275    FPredefineOrder: boolean;
     76    ImageTypeChanged : boolean;
     77    FFormFirstOpened: boolean;
     78    function NoPregnantSelection : Boolean;
     79    procedure ImageTypeChange;
     80    procedure FormFirstOpened(Sender: TObject);
    7381  protected
    7482    procedure InitDialog; override;
    7583    procedure Validate(var AnErrMsg: string); override;
    76     procedure SetDefaultPregant;   
     84    procedure SetDefaultPregant;
    7785  public
    7886    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    … …  
    8391{$R *.DFM}
    8492
    85 uses rODBase, rODRad, rOrders, uCore, rCore, fODRadApproval, fODRadConShRes, fLkUpLocation;
     93uses rODBase, rODRad, rOrders, uCore, rCore, fODRadApproval, fODRadConShRes, fLkUpLocation, fFrame,
     94  uFormMonitor;
    8695
    8796const
    … …  
    103112var
    104113  Radiologist, Contract, Research: string ;
    105   AName: string;
     114  AName, IsPregnant: string;
    106115  ALocation, AType: integer;
    107 
     116 
    108117{ TfrmODBase common methods }
    109118
    … …  
    116125  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
    117126  begin
    118     if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_COPY) then
     127    if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then
    119128      FPredefineOrder := True;
    120129    FEditCopy := True;
    … …  
    125134        for i := 0 to Items.Count-1 do
    126135          if StrToIntDef(Piece(Items[i],U,4), 0) = DisplayGroup then ItemIndex := i;
     136        if OrderAction = ORDER_EDIT then
     137        begin
     138          Enabled := False;
     139          Color := clBtnFace;
     140        end;
    127141     end;
    128142    if Self.EvtID>0 then
    … …  
    171185          end;
    172186      end;
     187    //hds00007460
     188    tmpResp := FindResponseByName('PREGNANT',1);
     189    if tmpResp <> nil then
     190       if Length(tmpResp.EValue)>0 then
     191       begin
     192          IsPregnant := tmpResp.EValue;
     193          if IsPregnant = 'YES' then
     194             radPregnant.Checked := True
     195          else
     196          if IsPregnant = 'NO' then
     197             radPregnantNo.Checked := True
     198          else
     199          if IsPregnant = 'UNKNOWN' then
     200             radPregnantUnknown.Checked := True;
     201       end;
     202    //hds00007460
    173203    Changing := False;
    174204    FEditCopy := False;
    175205    OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
    176206    ControlChange(Self);
     207    FPredefineOrder := False;
    177208  end;
    178209end;
    … …  
    184215begin
    185216  if not FEditCopy then inherited;
     217
    186218  FPreOpDate := '';
    187219  FLastRadID := '';
    … …  
    203235      cboProcedure.Items.Add(FRadCommonCombo.Items[i]);
    204236    if FRadCommonCombo.Items.Count>0 then cboProcedure.InsertSeparator;
     237
    205238    calRequestDate.Text := 'TODAY';
    206239    SetControl(cboAvailMod, 'Modifiers');
    … …  
    286319  with cboCategory do if Length(ItemID)  > 0 then Responses.Update('CLASS',     1, ItemID, Text);
    287320  with cboSubmit do if Length(ItemID)    > 0 then Responses.Update('IMLOC',     1, ItemID, Text);
    288   with radPregnant do if Checked             then Responses.Update('PREGNANT',  1, 'Y'   , 'Yes')
     321  with radPregnant do if Checked                then Responses.Update('PREGNANT',  1, 'Y'   , 'Yes')
    289322                 else if not Enabled         then Responses.Update('PREGNANT',  1, ''    , '');
    290323  with radPregnantNo do if Checked           then Responses.Update('PREGNANT',  1, 'N'   , 'No');
    … …  
    387420  with calRequestDate do
    388421    if FMDateTime = 0 then SetError(TX_NO_DATE);
     422
    389423end;
    390424
    391425procedure TfrmODRad.cboProcedureNeedData(Sender: TObject;
    392426  const StartFrom: string; Direction, InsertAt: Integer);
     427
    393428begin
    394429  inherited ;
    395430  cboProcedure.ForDataUse(SubSetOfRadProcs(DisplayGroup, StartFrom, Direction));
    396 end;
     431 end;
    397432
    398433procedure TfrmODRad.cboAvailModMouseClick(Sender: TObject);
    … …  
    402437  Found: boolean;
    403438begin
     439  if (cboAvailMod.Items.Count < 1) or  //GE 04-30-05 prevent list index out of bounds when empty
     440     (cboAvailMod.ItemIndex < 0) then Exit;
    404441  Found := False;
    405442  with cboAvailMod do x := Items[ItemIndex];
    … …  
    445482   begin
    446483    if ItemID <> FLastRadID then
    447     begin
    448       FLastRadID := ItemID;
    449       if FPredefineOrder then
    450         FPredefineOrder := False;
    451     end else Exit;
     484     begin
     485       FLastRadID := ItemID;
     486       if FPredefineOrder then
     487         FPredefineOrder := False;
     488     end else Exit;
    452489    Changing := True;
    453490    if Sender <> Self then
    … …  
    539576procedure TfrmODRad.FormCreate(Sender: TObject);
    540577begin
     578  FFormFirstOpened := TRUE;
     579  ImageTypeChanged := false;
     580  frmFrame.pnlVisit.Enabled := false;
    541581  AutoSizeDisabled := True;
    542582  inherited;
    … …  
    567607    radPregnantUnknown.Enabled := False;
    568608  end else SetDefaultPregant;
     609  FormMonitorBringToFrontEvent(Self, FormFirstOpened);
    569610end;
    570611
    … …  
    575616begin
    576617  inherited;
    577   if FPredefineOrder then
    578     FPredefineOrder := False;
    579   if Changing or (cboImtype.ItemIndex = -1) then exit;
    580   with cboImType do DisplayGroup := StrToIntDef(Piece(Items[ItemIndex], U, 4), 0) ;
    581   if DisplayGroup = 0 then exit;
    582   CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup));   // ODForRad returns TStrings with defaults
    583   FPredefineOrder := False;
    584   InitDialog;
    585 end;
    586 
    587 procedure TfrmODRad.FormPaint(Sender: TObject);
    588 begin
    589   inherited;
    590   with cboImType do
    591     if not FEditCopy and (ItemIEN = 0) and (DroppedDown = False) and (Application.Active)
    592       then DroppedDown := True;
     618  ImageTypeChanged := true;
    593619end;
    594620
    … …  
    679705end;
    680706
     707
    681708procedure TfrmODRad.cboImTypeExit(Sender: TObject);
    682709begin
    683710  inherited;
    684   if FPredefineOrder then Exit
    685   else cboImTypeChange(Self);
     711  ImageTypeChange;
     712end;
     713
     714procedure TfrmODRad.FormClose(Sender: TObject; var Action: TCloseAction);
     715begin
     716  inherited;
     717  frmFrame.pnlVisit.Enabled := true;
     718  FormMonitorBringToFrontEvent(Self, nil);
     719end;
     720
     721procedure TfrmODRad.chkIsolationExit(Sender: TObject);
     722begin
     723  inherited;
     724  //Fix for CQ: 10025
     725  if TabIsPressed() then
     726    if NoPregnantSelection() then
     727      if radPregnant.CanFocus then
     728        radPregnant.SetFocus();
     729end;
     730
     731procedure TfrmODRad.calPreOpExit(Sender: TObject);
     732begin
     733  inherited;
     734  //Fix for CQ: 10025
     735  if ShiftTabIsPressed() then
     736    if NoPregnantSelection() then
     737      if radPregnant.CanFocus then
     738        radPregnant.SetFocus();
     739end;
     740
     741function TfrmODRad.NoPregnantSelection : Boolean;
     742begin
     743  result := not ((radPregnant.Checked) or (radPregnantNo.Checked) or (radPregnantUnknown.Checked));
     744end;
     745
     746procedure TfrmODRad.cboImTypeDropDownClose(Sender: TObject);
     747begin
     748  inherited;
     749  ImageTypeChange;
     750end;
     751
     752procedure TfrmODRad.ImageTypeChange;
     753begin
     754  if not ImageTypeChanged then Exit;
     755  ImageTypeChanged := false;
     756  if FPredefineOrder then
     757    FPredefineOrder := False;
     758  if Changing or (cboImtype.ItemIndex = -1) then exit;
     759  with cboImType do DisplayGroup := StrToIntDef(Piece(Items[ItemIndex], U, 4), 0) ;
     760  if DisplayGroup = 0 then exit;
     761  CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup));   // ODForRad returns TStrings with defaults
     762  FPredefineOrder := False;
     763  InitDialog;
     764end;
     765
     766procedure TfrmODRad.FormFirstOpened(Sender: TObject);
     767begin
     768  if(FFormFirstOpened) then
     769  begin
     770    FFormFirstOpened := FALSE;
     771    with cboImType do
     772      if not FEditCopy and (ItemIEN = 0) and (DroppedDown = False) and (Application.Active) then
     773      begin
     774        cboImType.DroppedDown := TRUE;
     775      end;
     776  end;
    686777end;
    687778

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODVitals.dfm

    r459 r460  
    11inherited frmODVitals: TfrmODVitals
    2   Left = 273
    3   Top = 211
     2  Left = 721
     3  Top = 363
    44  Caption = 'Vital Measurement Order'
    55  PixelsPerInch = 96
    … …  
    6464    ListItemsOnly = False
    6565    LongList = False
     66    LookupPiece = 0
    6667    MaxLength = 0
    6768    Pieces = '2'
    … …  
    7071    TabOrder = 4
    7172    OnChange = ControlChange
     73    CharsNeedMatch = 1
    7274  end
    7375  object cboSchedule: TORComboBox
    … …  
    8688    ListItemsOnly = False
    8789    LongList = False
     90    LookupPiece = 0
    8891    MaxLength = 0
    8992    Pieces = '2'
    … …  
    9295    TabOrder = 5
    9396    OnChange = ControlChange
     97    CharsNeedMatch = 1
    9498  end
    9599  object calStart: TORDateBox

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fODVitals.pas

    r459 r460  
    3838    procedure FormCreate(Sender: TObject);
    3939    procedure ControlChange(Sender: TObject);
     40    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    4041  private
    4142    { Private declarations }
    … …  
    5455{$R *.DFM}
    5556
    56 uses uConst, ORFn, rODBase;
     57uses uConst, ORFn, rODBase, fFrame;
    5758
    5859const
    … …  
    6465procedure TfrmODVitals.FormCreate(Sender: TObject);
    6566begin
     67  frmFrame.pnlVisit.Enabled := false;
    6668  inherited;
    6769  FillerID := 'OR';                     // does 'on Display' order check **KCM**
    … …  
    138140end;
    139141
     142procedure TfrmODVitals.FormClose(Sender: TObject;
     143  var Action: TCloseAction);
     144begin
     145  inherited;
     146  frmFrame.pnlVisit.Enabled := true;
     147end;
     148
    140149end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOMSet.pas

    r459 r460  
    2626    procedure FormCreate(Sender: TObject);
    2727  private
     28    DoingNextItem : Boolean;
     29    CloseRequested : Boolean;
    2830    FDelayEvent: TOrderDelayEvent;
    2931    FClosing: Boolean;
    … …  
    105107var
    106108  SetItem: TSetItem;
     109  theOwner: TComponent;
    107110
    108111  procedure SkipToNext;
    … …  
    113116
    114117begin
     118  DoingNextItem := true;
    115119  //frmFrame.UpdatePtInfoOnRefresh;
    116120  if FClosing then Exit;
    … …  
    158162                    SkipToNext;
    159163                end;
    160     'O':      if not ActivateOrderSet(  IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then
    161               begin
    162                 if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
    163                   lstSet.Checked[lstSet.ItemIndex] := True
    164                 else SkipToNext;
     164    'O':      begin
     165                if (Self.Owner.Name = 'frmOMNavA') then theOwner := Self.Owner else theOwner := self;
     166                if not ActivateOrderSet( IntToStr(SetItem.DialogIEN), FDelayEvent, theOwner, ItemIndex) then
     167                begin
     168                  if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
     169                    lstSet.Checked[lstSet.ItemIndex] := True
     170                  else SkipToNext;
     171                end;
    165172              end;
    166173    else      begin
    … …  
    170177    end; {case}
    171178  end; {with lstSet}
     179  DoingNextItem := false;
    172180end;
    173181
    … …  
    178186  if Message.WParam = lstSet.ItemIndex then
    179187    if lstSet.ItemIndex < lstSet.Items.Count - 1 then DoNextItem else Close;
     188  if CloseRequested then
     189    Close;
    180190end;
    181191
    … …  
    197207    begin
    198208      SendMessage(TWinControl(SetItem.OwnedBy).Handle, UM_DESTROY, SetItem.RefNum, 0);
    199       Exit;
     209      //Exit;
    200210    end;
    201211  end;
    … …  
    219229  FClosebyDeaCheck := False;
    220230  NoFresh := True;
     231  CloseRequested := false;
     232  DoingNextItem := false;
    221233end;
    222234
    … …  
    264276procedure TfrmOMSet.cmdInteruptClick(Sender: TObject);
    265277begin
    266   Close;
     278  if DoingNextItem then
     279    CloseRequested := true              //Fix for CQ: 8297
     280  else
     281    Close;
    267282end;
    268283

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOMVerify.pas

    r459 r460  
    3030{$R *.DFM}
    3131
    32 uses ORFn, uConst, fFrame, rMisc;
     32uses ORFn, uConst, fFrame, rMisc, uODBase;
    3333
    3434procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean);
    … …  
    3737  tempStrs,prompts: TStringList;
    3838  flag: boolean;
     39  HasObjects: boolean;
    3940
    4041  function CutoffOutptPrompts(const promptIDs: TStringList; var promptList: TStringList): boolean;
    … …  
    8384      SetBounds(frmFrame.Left, frmFrame.Top + frmFrame.Height - Height, Width, Height);
    8485      SetFormPosition(frmOMVerify);
     86      ExpandOrderObjects(VerifyText, HasObjects);
    8587      memText.Lines.SetText(PChar(VerifyText));
    8688      ShowModal;

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrderFlag.dfm

    r459 r460  
    8787    OnExit = cboOnExit
    8888    OnNeedData = cboAlertRecipientNeedData
     89    CharsNeedMatch = 1
    8990  end
    9091end

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrderFlag.pas

    r459 r460  
    5757  finally
    5858    frmFlagOrder.Release;
     59    AlertRecip := 0;
    5960  end;
    6061end;

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrderSaveQuick.pas

    r459 r460  
    104104  DGroupName, QuickName, CRC: string;
    105105  NewIEN, AnIndex, i: Integer;
     106  IsClinicOrder: boolean;
    106107begin
    107108  Result := False;
    108109  CRC := ResponseSet.OrderCRC;
     110  IsClinicOrder := False;
    109111  if CRC = EMPTY_CRC then
    110112  begin
    … …  
    117119    with frmSaveQuickOrder do
    118120    begin
     121      if (ResponseSet.DisplayGroup = ClinDisp) and (ResponseSet.Dialog = 'PSJI OR PAT FLUID OE') then
     122        begin
     123          ResponseSet.DisplayGroup := IVDisp;
     124          IsClinicOrder := True;
     125        end;
    119126      if ResponseSet.DisplayGroup = ClinDisp then
    120127        DGroupName := NameOfDGroup(InptDisp)
    … …  
    156163          SaveQuickListForOD(lstQuickList.Items, ResponseSet.DisplayGroup);
    157164      end; {if OKPressed}
     165      if IsClinicOrder = True then ResponseSet.DisplayGroup := ClinDisp;
    158166    end; {with frmSaveQuickOrder}
    159167  finally

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrders.dfm

    r459 r460  
    11inherited frmOrders: TfrmOrders
    2   Left = 142
    3   Top = 63
    4   Width = 698
     2  Left = 451
     3  Top = 250
     4  Width = 774
    55  Height = 579
    66  HelpContext = 4000
    … …  
    1414  inherited shpPageBottom: TShape
    1515    Top = 528
    16     Width = 690
     16    Width = 766
    1717  end
    1818  inherited sptHorz: TSplitter
    1919    Left = 117
    2020    Height = 528
     21    OnMoved = sptHorzMoved
    2122  end
    2223  inherited pnlLeft: TPanel
    … …  
    102103  inherited pnlRight: TPanel
    103104    Left = 121
    104     Width = 569
     105    Width = 645
    105106    Height = 528
    106107    ParentColor = True
    … …  
    111112      Left = 0
    112113      Top = 0
    113       Width = 569
     114      Width = 645
    114115      Height = 19
    115116      Align = alTop
    … …  
    144145      Left = 0
    145146      Top = 19
    146       Width = 569
     147      Width = 645
    147148      Height = 17
    148149      DragReorder = False
    … …  
    179180          ImageIndex = -1
    180181          MinWidth = 16
    181           Text = 'Nrs'
     182          Text = 'Nurse'
    182183          Width = 40
    183184        end
    … …  
    185186          ImageIndex = -1
    186187          MinWidth = 16
    187           Text = 'Clk'
     188          Text = 'Clerk'
    188189          Width = 35
    189190        end
    … …  
    197198          ImageIndex = -1
    198199          MinWidth = 16
    199           Text = 'Sts'
     200          Text = 'Status'
    200201          Width = 50
    201202        end
    … …  
    206207          Width = 40
    207208        end>
     209      OnSectionClick = hdrOrdersSectionClick
    208210      OnSectionResize = hdrOrdersSectionResize
    209211      OnMouseDown = hdrOrdersMouseDown
    … …  
    213215      Left = 0
    214216      Top = 36
    215       Width = 569
     217      Width = 645
    216218      Height = 492
    217219      Style = lbOwnerDrawVariable
    … …  
    301303        end
    302304      end
     305      object mnuViewInformation: TMenuItem
     306        Caption = 'Information'
     307        OnClick = mnuViewInformationClick
     308        object mnuViewDemo: TMenuItem
     309          Tag = 1
     310          Caption = 'De&mographics...'
     311          OnClick = ViewInfo
     312        end
     313        object mnuViewVisits: TMenuItem
     314          Tag = 2
     315          Caption = 'Visits/Pr&ovider...'
     316          OnClick = ViewInfo
     317        end
     318        object mnuViewPrimaryCare: TMenuItem
     319          Tag = 3
     320          Caption = 'Primary &Care...'
     321          OnClick = ViewInfo
     322        end
     323        object mnuViewMyHealtheVet: TMenuItem
     324          Tag = 4
     325          Caption = 'MyHealthe&Vet...'
     326          OnClick = ViewInfo
     327        end
     328        object mnuInsurance: TMenuItem
     329          Tag = 5
     330          Caption = '&Insurance...'
     331          OnClick = ViewInfo
     332        end
     333        object mnuViewFlags: TMenuItem
     334          Tag = 6
     335          Caption = '&Flags...'
     336          OnClick = ViewInfo
     337        end
     338        object mnuViewRemoteData: TMenuItem
     339          Tag = 7
     340          Caption = 'Remote &Data...'
     341          OnClick = ViewInfo
     342        end
     343        object mnuViewReminders: TMenuItem
     344          Tag = 8
     345          Caption = '&Reminders...'
     346          Enabled = False
     347          OnClick = ViewInfo
     348        end
     349        object mnuViewPostings: TMenuItem
     350          Tag = 9
     351          Caption = '&Postings...'
     352          OnClick = ViewInfo
     353        end
     354      end
    303355      object Z1: TMenuItem
    304356        Caption = '-'
    … …  
    522574      OnClick = mnuActSignClick
    523575    end
     576    object mnuOptimizeFields: TMenuItem
     577      Caption = 'Adjust Column Size'
     578      Visible = False
     579      OnClick = mnuOptimizeFieldsClick
     580    end
    524581  end
    525582end

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrders.pas

    r459 r460  
    8989    sptVert: TSplitter;
    9090    mnuViewExpired: TMenuItem;
     91    mnuViewInformation: TMenuItem;
     92    mnuViewDemo: TMenuItem;
     93    mnuViewVisits: TMenuItem;
     94    mnuViewPrimaryCare: TMenuItem;
     95    mnuViewMyHealtheVet: TMenuItem;
     96    mnuInsurance: TMenuItem;
     97    mnuViewFlags: TMenuItem;
     98    mnuViewReminders: TMenuItem;
     99    mnuViewRemoteData: TMenuItem;
     100    mnuViewPostings: TMenuItem;
     101    mnuOptimizeFields: TMenuItem;
    91102    procedure mnuChartTabClick(Sender: TObject);
    92103    procedure FormCreate(Sender: TObject);
    … …  
    146157    procedure hdrOrdersMouseDown(Sender: TObject; Button: TMouseButton;
    147158      Shift: TShiftState; X, Y: Integer);
     159    procedure ViewInfo(Sender: TObject);
     160    procedure mnuViewInformationClick(Sender: TObject);
     161    procedure mnuOptimizeFieldsClick(Sender: TObject);
     162    procedure hdrOrdersSectionClick(HeaderControl: THeaderControl;
     163      Section: THeaderSection);
     164    procedure sptHorzMoved(Sender: TObject);
    148165  private
    149166    { Private declarations }
    … …  
    188205    procedure UseDefaultSort;
    189206    procedure SynchListToOrders;
     207//    procedure ActivateDeactiveRenew;
    190208    procedure ValidateSelected(const AnAction, WarningMsg, WarningTitle: string);
    191209    procedure ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string;
    … …  
    196214    function MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer;
    197215    function GetPlainText(AnOrder: TOrder; index: integer):string;
     216    function PatientStatusChanged: boolean;   
    198217    procedure UMEventOccur(var Message: TMessage); message UM_EVENTOCCUR;
     218    function CheckOrderStatus: boolean;
    199219  public
    200220    procedure setSectionWidths; //CQ6170
    … …  
    229249    property EvtColWidth: integer       read FEvtColWidth        write FEvtColWidth;
    230250    property DontCheck: boolean         read FDontCheck          write FDontCheck;
    231     property ParentComplexOrderID: string       read FParentComplexOrderID        write FParentComplexOrderID; 
     251    property ParentComplexOrderID: string       read FParentComplexOrderID        write FParentComplexOrderID;
    232252  end;
    233253
    … …  
    247267     fOMNavA, rCore, fOCSession, fOrdersPrint, fOrdersTS, fEffectDate, fODActive, fODChild,
    248268     fOrdersCopy, fOMVerify, fODAuto, rODBase, uODBase, rMeds,fODValidateAction, fMeds, uInit, fBALocalDiagnoses,
    249   fODConsult;
     269     fODConsult, fClinicWardMeds, fActivateDeactivate;
    250270
    251271{$R *.DFM}
    … …  
    970990          if ((TOrder(Items.Objects[i]).DGroupName = 'Inpt. Meds') or
    971991              (TOrder(Items.Objects[i]).DGroupName = 'Out. Meds') or
    972               (TOrder(Items.Objects[i]).DGroupName = 'IV Fluids')) then
     992              (TOrder(Items.Objects[i]).DGroupName = 'Clin. Orders') or
     993              (TOrder(Items.Objects[i]).DGroupName = 'Infusion')) then
    973994            begin
    974995              tmpList.Add('');
    … …  
    9931014          ReportBox(tmpList, 'Order Details - ' + BigOrderID, True);
    9941015        end;
     1016      StatusText('');
     1017      if (frmFrame.TimedOut) or (frmFrame.CCOWDrivedChange) then Exit; //code added to correct access violation on timeout
    9951018      Selected[i] := False;
    996       StatusText('');
    997     end;
     1019      end;
    9981020  finally
    9991021    tmpList.Free;
    … …  
    13241346      7: result := ChartRev;
    13251347      8: result := NameOfStatus(Status);
    1326       9:
    1327       begin
    1328         result := MixedCase(Anorder.OrderLocName);
    1329         if (Index > 0) and (result = TOrder(lstOrders.Items.Objects[Index - 1]).OrderLocName) then result := '';
    1330       end;
     1348      9: result := MixedCase(Anorder.OrderLocName);
     1349      //begin AGP change 26.52 display all location for orders.
     1350        //result := MixedCase(Anorder.OrderLocName);
     1351        //if (Index > 0) and (result = TOrder(lstOrders.Items.Objects[Index - 1]).OrderLocName) then result := '';
     1352      //end;
    13311353    end;
    13321354  end;
    … …  
    14351457  NextIndex: Integer;
    14361458begin
    1437 
     1459  if PatientStatusChanged then exit;
    14381460  if BILLING_AWARE then //CQ5114
    14391461     fODConsult.displayDXCode := ''; //CQ5114
    … …  
    15341556  BadList  := TStringList.Create;
    15351557  CheckedList := TStringList.Create;
    1536   with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
    1537   begin
    1538     AnOrder := TOrder(Items.Objects[i]);
    1539     //AGP Change 25.34 to fix problem with renewing inpatient meds from an outpatient location
    1540     if (AnAction = 'RN') and (AnOrder.Status=6) and (AnOrder.DGroupName = 'Inpt. Meds') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
    1541        begin
    1542          Selected[i] := False;
    1543          MessageDlg('You can not renew inpatient medication order on a clinic location for selected inpatient.', mtWarning, [mbOK], 0);
    1544        end;
    1545     if (AnAction = 'RN') or (AnAction = 'EV') then // or (AnAction = 'RW') then
    1546     begin
    1547       if not IsValidSchedule(AnOrder.ID) then
    1548       begin
    1549         if (AnAction = 'RN') then
    1550           ShowMessage('The order contains invalid schedule and can not be renewed.')
    1551         else if (AnAction = 'EV') then
    1552           ShowMessage('The order contains invalid schedule and can not be changed to event delayed order.');
    1553         //else if (AnAction = 'RW') then
    1554         //  ShowMessage('The order contains invalid schedule and can not be copied.);
     1558  try
     1559    with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
     1560    begin
     1561      AnOrder := TOrder(Items.Objects[i]);
     1562      if (AnAction = 'RN') and (AnOrder.Status=6) and (AnOrder.DGroupName = 'Inpt. Meds') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
     1563         begin
     1564           Selected[i] := False;
     1565           MessageDlg('You cannot renew inpatient medication order on a clinic location for selected inpatient.', mtWarning, [mbOK], 0);
     1566         end;
     1567      if ((AnAction = 'RN') or (AnAction = 'EV')) and (AnOrder.EnteredInError = 0) then  //AGP Changes PSI-04053
     1568      begin
     1569        if not IsValidSchedule(AnOrder.ID) then
     1570        begin
     1571          if (AnAction = 'RN') then
     1572            ShowMessage('The order contains invalid schedule and can not be renewed.')
     1573          else if (AnAction = 'EV') then
     1574            ShowMessage('The order contains invalid schedule and can not be changed to event delayed order.');
     1575
     1576          Selected[i] := False;
     1577          Continue;
     1578        end;
     1579      end;
     1580      //AGP CHANGE ORDER ENTERED IN ERROR TO ALLOW SIGNATURE AND VERIFY ACTIONS 26.23
     1581      if ((AnOrder.EnteredInError = 1) and ((AnOrder.Status = 1) or (AnOrder.Status = 13)))  and ((AnAction <> 'ES') and (AnAction <> 'VR')) then
     1582         begin
     1583            InfoBox(AnOrder.Text + WarningMsg + 'This order has been mark as Entered in error.', WarningTitle, MB_OK);
     1584            Selected[i] := False;
     1585            Continue;
     1586         end;
     1587      if ((AnAction <> OA_RELEASE) and (AnOrder.EnteredInError = 0)) or (((AnOrder.EnteredInError = 1) and ((AnOrder.Status = 1) or (AnOrder.Status = 13))) and
     1588            (AnAction = 'ES')) then
     1589         ValidateOrderAction(AnOrder.ID, AnAction, ErrMsg)
     1590      //AGP END Changes
     1591        else ErrMsg := '';
     1592      if (Length(ErrMsg)>0) and (Pos('COMPLEX-PSI',ErrMsg)<1) then
     1593      begin
     1594        InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
    15551595        Selected[i] := False;
    15561596        Continue;
    15571597      end;
    1558     end;
    1559     if AnAction <> OA_RELEASE then ValidateOrderAction(AnOrder.ID, AnAction, ErrMsg)
    1560       else ErrMsg := '';
    1561     if (Length(ErrMsg)>0) and (Pos('COMPLEX-PSI',ErrMsg)<1) then
    1562     begin
    1563       InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
    1564       Selected[i] := False;
    1565       Continue;
    1566     end;
    1567     if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(AnOrder.ID) and (AnAction <> 'RL') then
    1568     begin
    1569       InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
    1570       Selected[i] := False;
    1571       Continue;
    1572     end;
    1573     if (Length(ErrMsg)>0) and ( (AnAction = OA_CHGEVT) or (AnAction = OA_EDREL) ) then
    1574     begin
    1575       InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
    1576       Selected[i] := False;
    1577       Continue;
    1578     end;
    1579     AParentID := '';
    1580     IsValidActionOnComplexOrder(AnOrder.ID, AnAction,TListBox(lstOrders),CheckedList,ErrMsg, AParentID);
    1581     TOrder(Items.Objects[i]).ParentID := AParentID;
    1582     if (Length(ErrMsg)=0) and (AnAction=OA_EDREL) then
     1598      if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(AnOrder.ID) and (AnAction <> 'RL') then
     1599      begin
     1600        InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
     1601        Selected[i] := False;
     1602        Continue;
     1603      end;
     1604      if (Length(ErrMsg)>0) and ( (AnAction = OA_CHGEVT) or (AnAction = OA_EDREL) ) then
     1605      begin
     1606        InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
     1607        Selected[i] := False;
     1608        Continue;
     1609      end;
     1610      AParentID := '';
     1611      IsValidActionOnComplexOrder(AnOrder.ID, AnAction,TListBox(lstOrders),CheckedList,ErrMsg, AParentID);
     1612      TOrder(Items.Objects[i]).ParentID := AParentID;
     1613      if (Length(ErrMsg)=0) and (AnAction=OA_EDREL) then
     1614         begin
     1615           if (AnOrder.Signature = 2) and (not VerbTelPolicyOrder(AnOrder.ID)) then
     1616              begin
     1617                ErrMsg := 'Need to be signed first.';
     1618                Selected[i] := False;
     1619              end;
     1620         end;
     1621
     1622      if (AnAction = OA_CHGEVT) or (AnAction = OA_EDREL) then
     1623         begin
     1624           if Length(ErrMsg)>0 then
     1625              begin
     1626                Selected[i] := False;
     1627                Badlist.Add(AnOrder.Text + '^' + ErrMsg);
     1628              end
     1629           else
     1630             GoodList.Add(AnOrder.Text);
     1631         end;
     1632
     1633      if (Length(ErrMsg) > 0) and (AnAction <> OA_CHGEVT) and (AnAction <> OA_EDREL) then
     1634         begin
     1635           if Pos('COMPLEX-PSI',ErrMsg)>0 then ErrMsg := TX_COMPLEX;
     1636           InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
     1637           Selected[i] := False;
     1638         end;
     1639
     1640      if Selected[i] and (not OrderIsLocked(AnOrder.ID, AnAction)) then Selected[i] := False;
     1641
     1642    end; //with
     1643
     1644    if ((AnAction = OA_CHGEVT) or (AnAction = OA_EDREL)) then
    15831645       begin
    1584          if (AnOrder.Signature = 2) and (not VerbTelPolicyOrder(AnOrder.ID)) then
    1585             begin
    1586               ErrMsg := 'Need to be signed first.';
    1587               Selected[i] := False;
    1588             end;
     1646        if (BadList.Count = 1) and (GoodList.Count < 1 ) then
     1647          InfoBox(Piece(BadList[0],'^',1) + WarningMsg + Piece(BadList[0],'^',2), WarningTitle, MB_OK);
     1648        if ((BadList.Count >= 1) and (GoodList.Count >= 1)) or ( BadList.Count > 1 )then
     1649          DisplayOrdersForAction(BadList,GoodList,AnAction);
    15891650       end;
    1590 
    1591     if (AnAction = OA_CHGEVT) or (AnAction = OA_EDREL) then
    1592        begin
    1593          if Length(ErrMsg)>0 then
    1594             begin
    1595               Selected[i] := False;
    1596               Badlist.Add(AnOrder.Text + '^' + ErrMsg);
    1597             end
    1598          else
    1599            GoodList.Add(AnOrder.Text);
    1600        end;
    1601 
    1602     if (Length(ErrMsg) > 0) and (AnAction <> OA_CHGEVT) and (AnAction <> OA_EDREL) then
    1603        begin
    1604          if Pos('COMPLEX-PSI',ErrMsg)>0 then ErrMsg := TX_COMPLEX;
    1605          InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
    1606          Selected[i] := False;
    1607        end;
    1608 
    1609     if Selected[i] and (not OrderIsLocked(AnOrder.ID, AnAction)) then Selected[i] := False;
    1610    
    1611   end; //with
    1612 
    1613   if ((AnAction = OA_CHGEVT) or (AnAction = OA_EDREL)) then
    1614      begin
    1615       if (BadList.Count = 1) and (GoodList.Count < 1 ) then
    1616         InfoBox(Piece(BadList[0],'^',1) + WarningMsg + Piece(BadList[0],'^',2), WarningTitle, MB_OK);
    1617       if ((BadList.Count >= 1) and (GoodList.Count >= 1)) or ( BadList.Count > 1 )then
    1618         DisplayOrdersForAction(BadList,GoodList,AnAction);
    1619      end;
     1651  finally
     1652    GoodList.Free;
     1653    BadList.Free;
     1654    CheckedList.Free;
     1655  end;
    16201656end;
    16211657
    … …  
    16821718  SelectedList := TList.Create;
    16831719  try
    1684     ValidateSelected(OA_DC, TX_NO_DC, TC_NO_DC);        // validate DC action on each order
     1720    //if CheckOrderStatus = True then Exit;
     1721    ValidateSelected(OA_DC, TX_NO_DC, TC_NO_DC); // validate DC action on each order
     1722    //ActivateDeactiveRenew;   AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
    16851723    MakeSelectedList(SelectedList);                     // build list of orders that remain
    16861724    // updating the Changes object happens in ExecuteDCOrders, based on individual order
    … …  
    17531791begin
    17541792  inherited;
    1755   if not EncounterPresentEDO then Exit; 
     1793  if not EncounterPresentEDO then Exit;
    17561794  if NoneSelected(TX_NOSEL) then Exit;
    17571795  if not AuthorizedUser then Exit;
    … …  
    17641802  SelectedList := TList.Create;
    17651803  try
     1804    if CheckOrderStatus = True then Exit;
    17661805    ValidateSelected(OA_CHGEVT, TX_NO_CV, TC_NO_CV);   // validate Change Event action on each order
    17671806    MakeSelectedList(SelectedList);                     // build list of orders that remain
    … …  
    17991838  SelectedList := TList.Create;
    18001839  try
     1840    if CheckOrderStatus = True then Exit;
    18011841    ValidateSelected(OA_HOLD, TX_NO_HOLD, TC_NO_HOLD);  // validate hold action on each order
    18021842    MakeSelectedList(SelectedList);                     // build list of orders that remain
    … …  
    18241864  SelectedList := TList.Create;
    18251865  try
     1866    if CheckOrderStatus = True then Exit;
    18261867    ValidateSelected(OA_UNHOLD, TX_NO_UNHOLD, TC_NO_UNHOLD);  // validate release hold action
    18271868    MakeSelectedList(SelectedList);                           // build list of selected orders
    … …  
    18501891  SelectedList := TList.Create;
    18511892  try
     1893    if CheckOrderStatus = True then Exit;
    18521894    ValidateSelected(OA_RENEW, TX_NO_RENEW, TC_NO_RENEW);  // validate renew action for each
    18531895    MakeSelectedList(SelectedList);                       // build list of orders that remain
    … …  
    20262068  try
    20272069    if NoneSelected(TX_NOSEL) then Exit;
     2070    if CheckOrderStatus = True then Exit;
    20282071    ValidateSelected(OA_CHANGE, TX_NO_CHANGE, TC_NO_CHANGE);
    20292072    if (FCurrentView.EventDelay.PtEventIFN>0) and
    … …  
    20672110    if NoneSelected(TX_NOSEL) then Exit;
    20682111    NewOrderCreated := False;
     2112    if CheckOrderStatus = True then Exit;
    20692113    ValidateSelected(OA_COPY, TX_NO_COPY, TC_NO_COPY);
    20702114    if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
    … …  
    22692313       UBACore.CompleteUnsignedBillingInfo(rpcGetUnsignedOrdersBillingData(OrderListSCEI) );
    22702314    end;
    2271    
     2315
    22722316   {billing Aware}
    22732317    ExecuteReleaseOrderChecks(SelectedList);            // call order checking
    … …  
    22792323      if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then
    22802324        UnsignedOrderAlertFollowup(Piece(RecordID, U, 2));
    2281     UpdateExpiringMedAlerts(Patient.DFN);
    2282     UpdateUnverifiedMedAlerts(Patient.DFN);
    2283     UpdateUnverifiedOrderAlerts(Patient.DFN);
     2325      if Active then
     2326      begin
     2327        UpdateExpiringMedAlerts(Patient.DFN);
     2328        UpdateUnverifiedMedAlerts(Patient.DFN);
     2329        UpdateUnverifiedOrderAlerts(Patient.DFN);
     2330      end;
    22842331    if not uInit.TimedOut then
    22852332      begin
    … …  
    23702417      NF_DNR_EXPIRING                  :
    23712418        ViewAlertedOrders('', STS_EXPIRING, '', False, True, 'All Services, Expiring');
    2372       NF_MEDICATIONS_EXPIRING          :
     2419      NF_MEDICATIONS_EXPIRING_INPT          :
     2420        begin
     2421          ViewAlertedOrders('', STS_EXPIRING, 'PHARMACY', False, True, 'Medications, Expiring');
     2422        end;
     2423      NF_MEDICATIONS_EXPIRING_OUTPT          :
    23732424        begin
    23742425          ViewAlertedOrders('', STS_EXPIRING, 'PHARMACY', False, True, 'Medications, Expiring');
    … …  
    25092560    if (ALocation > 0) and (ALocation <> Encounter.Location) then
    25102561    begin
    2511       if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES
    2512         then Encounter.Location := ALocation;
     2562    //gary
     2563      Encounter.Location := frmClinicWardMeds.ClinicOrWardLocation(Alocation);
     2564   //   if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES
     2565   //     then Encounter.Location := ALocation;
    25132566    end;
    25142567    if Encounter.Location = 0
    … …  
    30453098  inherited SetFontSize( FontSize );
    30463099  RedrawOrderList;
     3100  mnuOptimizeFieldsClick(self);
     3101  lstSheets.Repaint;
     3102  lstWrite.Repaint;
     3103  btnDelayedOrder.Repaint;
    30473104end;
    30483105
    … …  
    30503107begin
    30513108  inherited;
     3109  if PatientStatusChanged then exit;
    30523110  //frmFrame.UpdatePtInfoOnRefresh;
    30533111end;
    … …  
    30563114begin
    30573115  inherited;
     3116  if PatientStatusChanged then exit;
    30583117  //frmFrame.UpdatePtInfoOnRefresh;
    30593118end;
    … …  
    30623121begin
    30633122  inherited;
     3123  if PatientStatusChanged then exit;
    30643124  //frmFrame.UpdatePtInfoOnRefresh;
    30653125end;
    … …  
    30683128begin
    30693129  inherited;
     3130  if PatientStatusChanged then exit; 
    30703131  //frmFrame.UpdatePtInfoOnRefresh;
    30713132end;
    … …  
    31863247var
    31873248  i: integer;
    3188   totalSectionsWidth: integer;
     3249  totalSectionsWidth, originalwidth: integer;
    31893250begin
    31903251  inherited;
    31913252  //CQ6170
    31923253  totalSectionsWidth := getTotalSectionsWidth;
    3193 
    3194      if totalSectionsWidth > lstOrders.Width - 5 then
    3195         begin
    3196         for i := 0 to hdrOrders.Sections.Count-1 do
    3197            begin
    3198            hdrOrders.Sections[i].Width := origWidths[i];
    3199            lstOrders.Invalidate;
    3200            end;
    3201         end;
     3254  if totalSectionsWidth > lstOrders.Width - 5 then
     3255  begin
     3256    originalwidth := 0;
     3257    for i := 0 to hdrOrders.Sections.Count - 1 do
     3258      originalwidth := originalwidth + origWidths[i];
     3259    if originalwidth < totalSectionsWidth then
     3260    begin
     3261      for i := 0 to hdrOrders.Sections.Count - 1 do
     3262        hdrOrders.Sections[i].Width := origWidths[i];
     3263      lstOrders.Invalidate;
     3264    end;
     3265  end;
    32023266  //end CQ6170
    32033267end;
    … …  
    32093273end;
    32103274
     3275function TfrmOrders.PatientStatusChanged: boolean;
     3276const
     3277
     3278  msgTxt1 = 'Patient status was changed from ';
     3279  msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.';
     3280   //GE CQ9537  - Change message text
     3281  msgTxt3 = 'Patient has been admitted. ';
     3282  msgTxt4 = CRLF + 'You will be prompted to sign your orders.  Any new orders subsequently' +
     3283            CRLF +'entered and signed will be directed to the inpatient staff.';
     3284var
     3285  PtSelect: TPtSelect;
     3286  IsInpatientNow: boolean;
     3287  ptSts: string;
     3288begin
     3289  result := False;
     3290  SelectPatient(Patient.DFN, PtSelect);
     3291  IsInpatientNow := Length(PtSelect.Location) > 0;
     3292  if Patient.Inpatient <> IsInpatientNow then
     3293  begin
     3294    if (not Patient.Inpatient) then   //GE CQ9537  - Change message text
     3295       MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0)
     3296    else
     3297       begin
     3298          if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.';
     3299          MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0);
     3300       end;
     3301    frmFrame.mnuFileRefreshClick(Application);
     3302    Result := True;
     3303  end;
     3304end;
     3305
     3306function TfrmOrders.CheckOrderStatus: boolean;
     3307var
     3308i: integer;
     3309AnOrder: TOrder;
     3310begin
     3311    Result := False;
     3312    with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
     3313    begin
     3314      AnOrder := TOrder(Items.Objects[i]);
     3315      if AnORder.Status <> GetOrderStatus(AnOrder.ID) then
     3316         begin
     3317           MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0);
     3318           frmFrame.mnuFileRefreshClick(Application);
     3319           Result := True;
     3320           EXIT;
     3321         end;
     3322    end;
     3323end;
     3324
     3325(*procedure TfrmOrders.ActivateDeactiveRenew;
     3326var
     3327  i: Integer;
     3328  AnOrder: TOrder;
     3329  tmpArr: TStringList;
     3330begin
     3331    tmpArr := TStringList.Create;
     3332    with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
     3333    begin
     3334      AnOrder := TOrder(Items.Objects[i]);
     3335      if AnOrder.Status = 5 then tmpArr.Add(AnOrder.ID);
     3336    end;
     3337    if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr);
     3338end;  *)
     3339
     3340procedure TfrmOrders.ViewInfo(Sender: TObject);
     3341begin
     3342  inherited;
     3343  frmFrame.ViewInfo(Sender);
     3344end;
     3345
     3346procedure TfrmOrders.mnuViewInformationClick(Sender: TObject);
     3347begin
     3348  inherited;
     3349  mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
     3350  mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
     3351  mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
     3352  mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
     3353  mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
     3354  mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
     3355  mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
     3356  mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
     3357  mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
     3358end;
     3359
     3360procedure TfrmOrders.mnuOptimizeFieldsClick(Sender: TObject);
     3361var
     3362  totalSectionsWidth, unitvalue: integer;
     3363begin
     3364  totalSectionsWidth := pnlRight.Width - 3;
     3365  if totalSectionsWidth < 16 then exit;
     3366  unitvalue := round(totalSectionsWidth / 16);
     3367  with hdrOrders do
     3368  begin
     3369    Sections[1].Width := unitvalue;
     3370    Sections[2].Width := pnlRight.Width - (unitvalue * 10) - 5;
     3371    Sections[3].Width := unitvalue * 2;
     3372    Sections[4].Width := unitvalue * 2;
     3373    Sections[5].Width := unitvalue;
     3374    Sections[6].Width := unitvalue;
     3375    Sections[7].Width := unitvalue;
     3376    Sections[8].Width := unitvalue;
     3377    Sections[9].Width := unitvalue;
     3378  end;
     3379  hdrOrdersSectionResize(hdrOrders, hdrOrders.Sections[0]);
     3380  hdrOrders.Repaint;
     3381end;
     3382
     3383procedure TfrmOrders.hdrOrdersSectionClick(HeaderControl: THeaderControl;
     3384  Section: THeaderSection);
     3385begin
     3386  inherited;
     3387  //if Section = hdrOrders.Sections[1] then
     3388    mnuOptimizeFieldsClick(self);
     3389end;
     3390
     3391procedure TfrmOrders.sptHorzMoved(Sender: TObject);
     3392begin
     3393  inherited;
     3394  mnuOptimizeFieldsClick(self);
     3395end;
     3396
    32113397end.
    32123398

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersDC.dfm

    r459 r460  
    6565      ParentShowHint = False
    6666      ShowHint = True
     67      Sorted = True
    6768      TabOrder = 0
    6869      Caption = 'Reason for Discontinue (select one)'

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersDC.pas

    r459 r460  
    3636{$R *.DFM}
    3737
    38 uses rOrders, uCore, uConst, fOrders, UBAGlobals;
    39 { TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
    40 //, fOrderChildren;
     38uses rOrders, uCore, uConst, fOrders;
    4139
    4240function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
    … …  
    5250  OriginalID,APtEvtID,APtEvtName,AnEvtInfo,tmpPtEvt:  string;
    5351  PtEvtList: TStringList;
    54 { TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
    55 (*  tmpList: TList;
    56   j: integer;
    57   AChildOrder: TOrder;*)
    5852begin
    5953  Result := False;
    … …  
    6357  PtEvtList := TStringList.Create;
    6458  if SelectedList.Count = 0 then Exit;
    65 { TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
    66 //  tmpList := TList.Create;
    6759  frmDCOrders := TfrmDCOrders.Create(Application);
    6860  try
    … …  
    7264    begin
    7365      AnOrder    := TOrder(Items[i]);
    74 
    75       if BILLING_AWARE then  //CQ4589
    76         UBAGlobals.RemoveOrderFromDxList(AnOrder.ID);
    77 
    78 { TODO -oRich V. -cOutpatient Meals : Comment next 3 lines for processing of child orders treeview. }
    7966      frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
    8067      if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
    8168    end;
    82 { TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
    83 //***********  begin OP meals changes **************
    84 (*      if Copy(AnOrder.Text, 1, 1) = '+' then
    85       begin
    86         ActOnChildOrders(tmpList, AnOrder.ID);
    87 { TODO -oRich V. -cOutpatient Meals : How/when to get selected items into SelectedList? }
    88         for j := tmpList.Count - 1 downto 0 do
    89         begin
    90           AChildOrder := TOrder(tmpList.Items[j]);
    91           frmDCOrders.lstOrders.Items.Add(AChildOrder.Text);
    92           if not ((AChildOrder.Status = 11) and (AChildOrder.Signature = 2)) then NeedReason := True;
    93         end;
    94       end else
    95       begin
    96         frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
    97         if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
    98       end;
    99     end;*)
    100 //*************  End OP meals changes ****************
    10169    if NeedReason then
    10270    begin
    … …  
    12694                       end;
    12795        DCT_DELETION:  begin
    128                          if BILLING_AWARE then
    129                             UBAGlobals.BADeltedOrders.Add(OriginalID);
    13096                         Changes.Remove(CH_ORD, OriginalID);
    13197                         if (AnOrder.ID = '0') or (AnOrder.ID = '')
    … …  
    174140    else with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
    175141  finally
    176 { TODO -oRich V. -cOutpatient Meals : Uncomment for processing of child orders treeview. }
    177     //tmpList.Free;
    178142    frmDCOrders.Release;
    179143  end;
    … …  
    202166begin
    203167  inherited;
    204   if not (lstReason.ItemIEN > 0) then
     168  if (lstReason.Visible) and (not (lstReason.ItemIEN > 0)) then
    205169  begin
    206170    InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK);

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersOnChart.pas

    r459 r460  
    3333{$R *.DFM}
    3434
    35 uses rCore, rOrders, uConst, fOrdersPrint, uOrders;
     35uses rCore, rOrders, uConst, fOrdersPrint, uOrders, fFrame, UCore,
     36  fClinicWardMeds;
    3637
    3738const
    … …  
    4344var
    4445  frmOnChartOrders: TfrmOnChartOrders;
    45   i: Integer;
     46  i, PrintLoc: Integer;
    4647  SignList: TStringList;
    4748  OrderText: string;
    … …  
    6263begin
    6364  Result := False;
     65  PrintLoc := 0;
    6466  if SelectedList.Count = 0 then Exit;
    6567  frmOnChartOrders := TfrmOnChartOrders.Create(Application);
    … …  
    7880        StatusText('Sending Orders to Service(s)...');
    7981        if SignList.Count > 0 then SendOrders(SignList, '');
     82
     83         if (not frmFrame.TimedOut) then
     84          begin
     85             if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
     86                frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
     87             else
     88                if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
     89                   frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
     90          end;
     91          uCore.TempEncounterLoc := 0;
     92          uCore.TempEncounterLocName := '';
     93
    8094        with SignList do if Count > 0 then for i := 0 to Count - 1 do
    8195          begin
    … …  
    88102          end;
    89103        StatusText('');
    90         PrintOrdersOnSignRelease(SignList, NO_WRITTEN);
     104        PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc);
    91105//        SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt);  //*KCM*
    92106//        if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo);           //*KCM*

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersRelease.pas

    r459 r460  
    4141{$R *.DFM}
    4242
    43 uses Hash, rCore, rOrders, uConst, fSignItem, fOrdersPrint, uCore, uOrders, fRptBox;
     43uses Hash, rCore, rOrders, uConst, fSignItem, fOrdersPrint, uCore, uOrders, fRptBox,
     44  fFrame, fClinicWardMeds;
    4445
    4546const
    … …  
    5556var
    5657  frmReleaseOrders: TfrmReleaseOrders;
    57   i: Integer;
     58  i, PrintLoc: Integer;
    5859  SignList: TStringList;
    5960  OrderText: string;
    … …  
    8788begin
    8889  Result := False;
     90  PrintLoc := 0;
    8991  if SelectedList.Count = 0 then Exit;
    9092  frmReleaseOrders := TfrmReleaseOrders.Create(Application);
    … …  
    109111        StatusText('Sending Orders to Service(s)...');
    110112        if SignList.Count > 0 then SendOrders(SignList, frmReleaseOrders.ESCode);
     113
     114        if (not frmFrame.TimedOut) then
     115          begin
     116             if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
     117                frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
     118             else
     119                if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
     120                   frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
     121          end;
     122          uCore.TempEncounterLoc := 0;
     123          uCore.TempEncounterLocName := '';
     124
     125        //hds7591  Clinic/Ward movement.
     126
     127
    111128        with SignList do if Count > 0 then for i := 0 to Count - 1 do
    112129        begin
    … …  
    120137        end;
    121138        StatusText('');
    122         PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature);
     139        PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature, PrintLoc);
    123140//        SetupOrdersPrint(SignList, DeviceInfo, frmReleaseOrders.FNature, False, PrintIt); //*KCM*
    124141//        if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo);                       //*KCM*

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersRenew.dfm

    r459 r460  
    11inherited frmRenewOrders: TfrmRenewOrders
    2   Left = 273
    3   Top = 185
    4   Width = 450
    5   Height = 270
     2  Left = 434
     3  Top = 232
     4  HorzScrollBar.Tracking = True
     5  HorzScrollBar.Visible = True
     6  VertScrollBar.Tracking = True
     7  AutoScroll = False
    68  Caption = 'Renew Orders'
     9  ClientHeight = 416
     10  ClientWidth = 592
    711  Position = poScreenCenter
     12  Scaled = False
    813  OnClose = FormClose
    914  OnCreate = FormCreate
    … …  
    1116  PixelsPerInch = 96
    1217  TextHeight = 13
    13   object lstOrders: TListBox
    14     Left = 0
    15     Top = 17
    16     Width = 442
    17     Height = 185
    18     Style = lbOwnerDrawVariable
    19     Align = alClient
    20     Color = clCream
    21     ItemHeight = 13
    22     TabOrder = 0
    23     OnClick = lstOrdersClick
    24     OnDrawItem = lstOrdersDrawItem
    25     OnMeasureItem = lstOrdersMeasureItem
    26   end
    2718  object hdrOrders: THeaderControl
    2819    Left = 0
    2920    Top = 0
    30     Width = 442
     21    Width = 592
    3122    Height = 17
    3223    DragReorder = False
     24    Constraints.MinHeight = 17
    3325    Sections = <
    3426      item
     27        AutoSize = True
    3528        ImageIndex = -1
    3629        Text = 'Order to be Renewed'
    37         Width = 317
     30        Width = 296
    3831      end
    3932      item
     33        AutoSize = True
    4034        ImageIndex = -1
    4135        Text = 'Start/Stop Time'
    42         Width = 125
     36        Width = 296
    4337      end>
     38    OnSectionResize = hdrOrdersSectionResize
    4439  end
    45   object Panel1: TPanel
     40  object pnlBottom: TPanel
    4641    Left = 0
    47     Top = 202
    48     Width = 442
    49     Height = 41
     42    Top = 393
     43    Width = 592
     44    Height = 23
    5045    Align = alBottom
     46    Anchors = [akLeft, akTop, akRight, akBottom]
     47    AutoSize = True
    5148    TabOrder = 2
    5249    DesignSize = (
    53       442
    54       41)
     50      592
     51      23)
    5552    object cmdCancel: TButton
    56       Left = 362
    57       Top = 12
     53      Left = 512
     54      Top = 1
    5855      Width = 72
    5956      Height = 21
    … …  
    6158      Cancel = True
    6259      Caption = 'Cancel'
     60      Constraints.MinHeight = 21
    6361      TabOrder = 0
    6462      OnClick = cmdCancelClick
    6563    end
    6664    object cmdOK: TButton
    67       Left = 274
    68       Top = 12
     65      Left = 424
     66      Top = 1
    6967      Width = 72
    7068      Height = 21
    7169      Anchors = [akTop, akRight]
    7270      Caption = 'OK'
     71      Constraints.MinHeight = 21
    7372      Default = True
    7473      TabOrder = 1
    … …  
    7776    object cmdChange: TButton
    7877      Left = 8
    79       Top = 12
     78      Top = 1
    8079      Width = 145
    8180      Height = 21
    8281      Caption = 'Change...'
     82      Constraints.MinHeight = 21
    8383      Enabled = False
    8484      TabOrder = 2
    … …  
    8686    end
    8787  end
     88  object lstOrders: TCaptionListBox
     89    Left = 0
     90    Top = 17
     91    Width = 592
     92    Height = 376
     93    Style = lbOwnerDrawVariable
     94    Align = alClient
     95    Anchors = []
     96    Color = clCream
     97    Ctl3D = True
     98    ExtendedSelect = False
     99    Font.Charset = DEFAULT_CHARSET
     100    Font.Color = clWindowText
     101    Font.Height = -11
     102    Font.Name = 'MS Sans Serif'
     103    Font.Style = []
     104    ItemHeight = 24
     105    ParentCtl3D = False
     106    ParentFont = False
     107    ParentShowHint = False
     108    ShowHint = True
     109    TabOrder = 1
     110    OnClick = lstOrdersClick
     111    OnDrawItem = lstOrdersDrawItem
     112    OnMeasureItem = lstOrdersMeasureItem
     113    HintOnItem = True
     114  end
    88115end

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersRenew.pas

    r459 r460  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fAutoSz, StdCtrls, ORFn, ComCtrls, uConst, rODMeds, uOrders, fOCAccept,
    8   ExtCtrls, uODBase;
     8  ExtCtrls, uODBase, ORCtrls;
    99
    1010type
    1111  TfrmRenewOrders = class(TfrmAutoSz)
    12     lstOrders: TListBox;
    1312    hdrOrders: THeaderControl;
    14     Panel1: TPanel;
     13    pnlBottom: TPanel;
    1514    cmdCancel: TButton;
    1615    cmdOK: TButton;
    1716    cmdChange: TButton;
     17    lstOrders: TCaptionListBox;
    1818    procedure FormCreate(Sender: TObject);
    1919    procedure cmdOKClick(Sender: TObject);
    … …  
    2727    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    2828    procedure FormShow(Sender: TObject);
     29    procedure hdrOrdersSectionResize(HeaderControl: THeaderControl;
     30      Section: THeaderSection);
    2931  private
    3032    OKPressed: Boolean;
    … …  
    7880  IsInpt: boolean;
    7981  i,j: Integer;
    80   m: integer; //BAPHII 1.3.2
     82  //m: integer; //BAPHII 1.3.2
    8183  PkgInfo:string;
    8284  PlainText,RnErrMsg: string;
    … …  
    251253         AnOrder.LinkObject := nil;
    252254       end;
    253 
    254255    frmRenewOrders.Release;
    255256  end;
    256 
    257 
    258 
    259257end;
    260258
    … …  
    283281    DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN);
    284282    Height := HigherOf(TextHeight, DateHeight);
     283    if Height > 255 then Height := 255;  //This is maximum allowed by a windows listbox item.
    285284  end
    286285end;
    … …  
    427426end;
    428427
     428procedure TfrmRenewOrders.hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
     429begin
     430  inherited;
     431  lstOrders.Repaint; //CQ6367
     432end;
     433
     434
    429435end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersSign.dfm

    r459 r460  
    11object frmSignOrders: TfrmSignOrders
    2   Left = 379
    3   Top = 162
     2  Left = 400
     3  Top = 159
    44  Width = 585
    55  Height = 511
    … …  
    4343  object Label2: TStaticText
    4444    Left = 8
    45     Top = 144
     45    Top = 147
    4646    Width = 171
    4747    Height = 17
    4848    Caption = 'The following orders will be signed -'
    49     TabOrder = 4
     49    TabOrder = 3
    5050    TabStop = True
    5151  end
    … …  
    5858    Caption = 'OK'
    5959    Default = True
    60     TabOrder = 2
     60    TabOrder = 1
    6161    OnClick = cmdOKClick
    6262  end
    … …  
    6969    Cancel = True
    7070    Caption = 'Cancel'
    71     TabOrder = 3
     71    TabOrder = 2
    7272    OnClick = cmdCancelClick
    7373  end
    … …  
    192192    ShowHint = True
    193193    Style = lbOwnerDrawVariable
    194     TabOrder = 1
     194    TabOrder = 4
    195195    OnClick = clstOrdersClick
    196196    OnDrawItem = clstOrdersDrawItem
    … …  
    243243    object Diagnosis1: TMenuItem
    244244      Caption = '&Diagnosis...'
    245       Enabled = False
    246245      ShortCut = 32836
    247246      OnClick = buOrdersDiagnosisClick

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersSign.pas

    r459 r460  
    114114uses
    115115  Hash, rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, uSignItems, fOrders,
    116   fPCELex, rPCE, fODConsult, fBALocalDiagnoses;
     116  fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame;
    117117
    118118const
    … …  
    208208  cProvDUZ: Int64;
    209209  OrderText: string;
     210  PrintLoc: Integer;
    210211 // tempOrderID: string;
    211212
    … …  
    251252  Result := False;
    252253  DigSigErr := True;
    253   DigStoreErr := False;
    254   Obj := Nil;
     254  PrintLoc := 0;
    255255  if SelectedList.Count = 0 then Exit;
    256256  if BILLING_AWARE then
    … …  
    418418          if SignList.Count > 0 then
    419419          begin
     420
     421          //hds7591  Clinic/Ward movement.  Patient Admission IMO
     422          if not frmFrame.TimedOut then
     423          begin
     424             if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
     425                frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,uCore.Encounter.LocationName, PrintLoc)
     426             else
     427                if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
     428                   frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
     429          end;
     430          uCore.TempEncounterLoc := 0;
     431          uCore.TempEncounterLocName := '';
     432          //hds7591  Clinic/Ward movement  Patient Admission IMO
     433
    420434            SigItems.SaveSettings; // Save CoPay FIRST!
    421435            SendOrders(SignList, frmSignOrders.ESCode);
    422           end;
    423           with SignList do if Count > 0 then for i := 0 to Count - 1 do
     436
     437        end;
     438
     439            with SignList do if Count > 0 then for i := 0 to Count - 1 do
    424440            begin
    425441              if Pos('E', Piece(SignList[i], U, 2)) > 0 then
    … …  
    443459              if theSts = 10 then  SignList.Delete(cnt);  //signed delayed order should not be printed.
    444460          end;
    445           PrintOrdersOnSignRelease(SignList, NO_PROVIDER);
     461          PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc);
    446462        finally
    447463          SignList.Free;
    … …  
    505521
    506522procedure TfrmSignOrders.cmdOKClick(Sender: TObject);
    507 {Begin BillingAware}
    508 var
    509    BABillingRecs: TStringList;
    510 {End BillingAware}
    511523const
    512524  TX_NO_CODE  = 'An electronic signature code must be entered to sign orders.';
    … …  
    519531begin
    520532  inherited;
    521 {Begin BillingAware}
    522   if  BILLING_AWARE then
    523   begin
    524       BABillingRecs := TStringList.Create;
    525       BABillingRecs.Clear;
    526   end;
    527 {End BillingAware}
    528  
     533
    529534  if txtESCode.Visible and (Length(txtESCode.Text) = 0) then
    530535  begin
    … …  
    545550  begin
    546551    if SigItems.OK2SaveSettings then
    547       if Not BADxEntered then   //  if Dx have been entered and OK is pressed
     552   
     553      if Not UBACore.BADxEntered then   //  if Dx have been entered and OK is pressed
    548554         begin                     // billing data will be saved. otherwise error message!
    549555            InfoBox(TX_NO_DX, 'Sign Orders', MB_OK);
    … …  
    781787    begin
    782788       //Billing Awareness 'flyover' hint includes Dx code(s) when Dx code(s) have been assigned to an order
    783            thisRec := TBADxRecord.Create;
    784789           thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[Itm]).ID;
    785790
    … …  
    909914{Begin BillingAware}
    910915
    911   numSelected := 0;
    912916  match := false;
    913917  allBlank := false;
    … …  
    12641268  j: integer; //CQ5054
    12651269begin
    1266    //if BILLING_AWARE then
    1267     //begin
     1270
    12681271       if FOSTFHintWndActive then
    12691272       begin
    … …  
    12901293           //end CQ5054
    12911294       end;
    1292 
    1293     //end  //if BILLING_AWARE
    12941295end;
    12951296
    … …  
    13151316        end;
    13161317  end;
    1317 
    1318    x := 0;
    1319    y := 0;
    13201318
    13211319  try
    … …  
    13981396begin
    13991397   try
    1400       if BILLING_AWARE then
    1401          begin
    1402            if FOSTFhintWndActive then
    1403               begin
    1404               FOSTFhintWindow.ReleaseHandle;
    1405               FOSTFHintWndActive := False;
    1406               Application.ProcessMessages;
    1407               end;
    1408          end;
     1398      if FOSTFhintWndActive then
     1399      begin
     1400         FOSTFhintWindow.ReleaseHandle;
     1401         FOSTFHintWndActive := False;
     1402         Application.ProcessMessages;
     1403      end;
    14091404  except
    14101405     on E: Exception do
    … …  
    15181513procedure TfrmSignOrders.FormatListForScreenReader;
    15191514var
    1520   ListStateOn : boolean;
     1515  ListStateOn : longbool;
     1516  Success: longbool;
    15211517begin
    15221518  //Determine if a screen reader is currently being used.
    1523   SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0);
    1524   if ListStateOn then
    1525     SetItemTextToState
     1519  Success := SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0);
     1520  if Success and ListStateOn then
     1521    SetItemTextToState;
    15261522end;
    15271523

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOtherSchedule.dfm

    r459 r460  
    11object frmOtherSchedule: TfrmOtherSchedule
    2   Left = 355
    3   Top = 154
     2  Left = 544
     3  Top = 262
    44  AutoScroll = False
    55  Caption = 'Order with schedule '#39'OTHER'#39
    66  ClientHeight = 362
    7   ClientWidth = 341
     7  ClientWidth = 369
    88  Color = clBtnFace
    99  Constraints.MinHeight = 70
    … …  
    2323    Left = 0
    2424    Top = 82
    25     Width = 341
     25    Width = 369
    2626    Height = 8
    2727    Cursor = crVSplit
    … …  
    3333    Left = 0
    3434    Top = 0
    35     Width = 341
     35    Width = 369
    3636    Height = 82
    3737    Align = alTop
    … …  
    5050      Left = 52
    5151      Top = 4
    52       Width = 285
     52      Width = 313
    5353      Height = 74
    5454      Align = alClient
    … …  
    6464    Left = 0
    6565    Top = 90
    66     Width = 341
     66    Width = 369
    6767    Height = 272
    6868    Align = alClient
    … …  
    7272      Left = 1
    7373      Top = 1
    74       Width = 144
     74      Width = 176
    7575      Height = 202
    7676      Align = alLeft
    … …  
    7979      object cbo7: TCheckBox
    8080        Tag = 1
    81         Left = 45
     81        Left = 86
    8282        Top = 21
    8383        Width = 60
    … …  
    8989      object cbo1: TCheckBox
    9090        Tag = 2
    91         Left = 44
     91        Left = 85
    9292        Top = 48
    9393        Width = 60
    … …  
    9999      object cbo2: TCheckBox
    100100        Tag = 3
    101         Left = 44
     101        Left = 85
    102102        Top = 75
    103103        Width = 60
    … …  
    109109      object cbo3: TCheckBox
    110110        Tag = 4
    111         Left = 44
     111        Left = 85
    112112        Top = 102
    113113        Width = 60
    … …  
    119119      object cbo4: TCheckBox
    120120        Tag = 5
    121         Left = 44
     121        Left = 85
    122122        Top = 129
    123123        Width = 60
    … …  
    129129      object cbo5: TCheckBox
    130130        Tag = 6
    131         Left = 44
     131        Left = 85
    132132        Top = 156
    133133        Width = 60
    … …  
    139139      object cbo6: TCheckBox
    140140        Tag = 7
    141         Left = 44
     141        Left = 85
    142142        Top = 183
    143143        Width = 60
    … …  
    147147        OnClick = cbo6Click
    148148      end
     149      object Button1: TButton
     150        Left = 8
     151        Top = 64
     152        Width = 60
     153        Height = 19
     154        Caption = 'Everyday'
     155        TabOrder = 7
     156        OnClick = Button1Click
     157      end
    149158    end
    150159    object GroupBox2: TGroupBox
    151       Left = 152
     160      Left = 180
    152161      Top = 1
    153162      Width = 188
    … …  
    214223      end
    215224      object btnRemove: TButton
    216         Left = 114
     225        Left = 118
    217226        Top = 94
    218227        Width = 60
    219228        Height = 19
     229        Hint = 'Remove the selected time from the Day-of-Week schedule.'
    220230        Caption = 'Remove'
     231        ParentShowHint = False
     232        ShowHint = True
    221233        TabOrder = 2
    222234        OnClick = btnRemoveClick
     235      end
     236      object btnAdd: TButton
     237        Left = 118
     238        Top = 64
     239        Width = 60
     240        Height = 19
     241        Hint = 'Add the selected time to the Day-of-Week schedule'
     242        Caption = 'Add'
     243        ParentShowHint = False
     244        ShowHint = True
     245        TabOrder = 3
     246        OnClick = btnAddClick
    223247      end
    224248    end
    … …  
    226250      Left = 1
    227251      Top = 203
    228       Width = 339
     252      Width = 367
    229253      Height = 68
    230254      Align = alBottom
    231255      TabOrder = 2
    232256      DesignSize = (
    233         339
     257        367
    234258        68)
    235259      object Label1: TLabel
    … …  
    241265      end
    242266      object btn0k1: TButton
    243         Left = 176
     267        Left = 204
    244268        Top = 43
    245269        Width = 75
    … …  
    251275      end
    252276      object btnCancel: TButton
    253         Left = 257
     277        Left = 285
    254278        Top = 42
    255279        Width = 75
    … …  
    264288        Left = 64
    265289        Top = 8
    266         Width = 268
     290        Width = 296
    267291        Height = 21
    268292        Anchors = [akLeft, akTop, akRight]
     293        Color = clInfoBk
     294        Enabled = False
     295        Font.Charset = DEFAULT_CHARSET
     296        Font.Color = clWindowText
     297        Font.Height = -11
     298        Font.Name = 'MS Sans Serif'
     299        Font.Style = [fsBold]
     300        ParentFont = False
     301        ReadOnly = True
    269302        TabOrder = 0
    270303        OnChange = txtScheduleChange

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/fOtherSchedule.pas

    r459 r460  
    3535    memMessage: TMemo;
    3636    Splitter1: TSplitter;
     37    btnAdd: TButton;
     38    Button1: TButton;
    3739    procedure FormCreate(Sender: TObject);
    3840    procedure btnCancelClick(Sender: TObject);
    … …  
    5557    procedure lstMinuteKeyDown(Sender: TObject; var Key: Word;
    5658      Shift: TShiftState);
     59    procedure Button1Click(Sender: TObject);
    5760  private
    5861    FDaySchedule: array [1..7] of string;
    … …  
    6669    procedure UpdateOnFreeTextInput;
    6770    function CheckDay(ADayStr: string): string;
     71   
    6872  public
    6973  end;
    … …  
    8791   if frmOtherSchedule.ShowModal = mrOK then
    8892   begin
    89      ASchedule := frmOtherSchedule.FOtherSchedule;
     93     ASchedule := UpperCase(frmOtherSchedule.FOtherSchedule);
    9094     Result := True;
    9195   end;
    … …  
    121125procedure TfrmOtherSchedule.btn0k1Click(Sender: TObject);
    122126begin
     127  if (cbo1.Checked = false) and (cbo2.Checked = false) and (cbo3.Checked = false) and (cbo4.Checked = false) and (cbo5.Checked = false) and
     128    (cbo6.Checked = false) and (cbo7.Checked = false) then
     129    begin
     130      ShowMessage('A day of week must be selected!');
     131      Exit;
     132    end;
    123133  if not IsValidSchStr(FOtherSchedule) then
    124134  begin
    … …  
    176186var
    177187  i : integer;
    178   TimePart, DayPart: string;
     188  TimePart, DayPart,APRN,ASearchTxt: string;
    179189begin
    180190  TimePart := '';
    181191  DayPart := '';
     192  APRN := '';
     193  ASearchTxt := UpperCase(txtSchedule.Text);
     194  if StrPos(PChar(ASearchTxt),PChar('PRN')) <> nil then APRN := ' PRN'; //hds8326 retain PRN free text if data time entered
    182195  for i := 0 to FTimeSchedule.Count - 1 do
    183196  begin
    … …  
    201214  end
    202215  else FOtherSchedule := TimePart;
     216  if Length(APRN) > 0 then FOtherSchedule := FOtherSchedule + APRN; //hds8326 retain PRN free text if data time entered
    203217  txtSchedule.Text := FOtherSchedule;
    204218end;
    … …  
    368382  var
    369383    idx: integer;
     384    x: string;
    370385  begin
    371386    for idx := aDList.Count - 1 downto 0 do
    372387    begin
     388    // cq hds8326 PRN entered manually split PRN from DOW to retain last DOW
     389      x := UpperCase(aDList.Strings[idx]); // added to properly process DOW when followed by a space "PRN".
     390      if Piece(x,' ',2) = 'PRN' then
     391         aDLIst.Strings[idx] := Piece(x,' ',1);
     392    // cq hds8326
    373393      if ((CheckDay(aDList[idx]) = 'SUN') or (CheckDay(aDList[idx]) = 'SU')) then
    374394        begin
    … …  
    419439begin
    420440  inherited;
    421   i := 0;
    422441  dayStr  := '';
    423442  timeStr := '';
    … …  
    437456  begin
    438457    Val(Piece(txtSchedule.Text,'-',1), i, Code);
     458    if i = 0 then begin end;  // just to make compiler not give hint
    439459    if Code <> 0 then dayStr := Trim(txtSchedule.Text)
    440460    else timeStr := Trim(txtSchedule.Text);
    … …  
    463483begin
    464484  inherited;
    465   lstMinute.ItemIndex := -1;
     485  if lstMinute.ItemIndex = -1 then lstMinute.ItemIndex :=0;
    466486end;
    467487
    … …  
    509529  FFromCheckBox := True;
    510530  if lstHour.ItemIndex < 0 then Exit;
    511   btnAddClick(Self);
     531  //btnAddClick(Self);
    512532  FFromCheckBox := False;
    513533end;
    … …  
    521541    FFromCheckBox := True;
    522542    if lstHour.ItemIndex < 0 then Exit;
    523     btnAddClick(Self);
     543    //btnAddClick(Self);
    524544    FFromCheckBox := False;
    525545  end;
    526546end;
    527547
     548procedure TfrmOtherSchedule.Button1Click(Sender: TObject);
     549begin
     550  inherited;
     551   cbo1.Checked := true;
     552   cbo2.Checked := true;
     553   cbo3.Checked := true;
     554   cbo4.Checked := true;
     555   cbo5.Checked := true;
     556   cbo6.Checked := true;
     557   cbo7.Checked := true;
     558end;
     559
    528560end.
    529561

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/rODAllergy.pas

    r459 r460  
    4949  end;
    5050
     51  TARTClinUser = record
     52    IsClinUser: boolean;
     53    ReasonFailed: string;
     54    AccessChecked: boolean;
     55  end;
     56
    5157function SearchForAllergies(StringToMatch: string): TStrings;
    5258function SubsetofSymptoms(const StartFrom: string; Direction: Integer): TStrings;
    … …  
    6470function RequireOriginatorComments: boolean;
    6571function EnableErrorComments: boolean;
     72function IsARTClinicalUser(var AMessage: string): boolean;
    6673
    6774implementation
    … …  
    7380  uARTPatchInstalled: TARTPatchInstalled;
    7481  uGMRASiteParams: TGMRASiteParams;
     82  uARTClinUser: TARTClinUser;
    7583
    7684function ODForAllergies: TStrings;
    … …  
    326334end;
    327335
     336(*function IsARTClinicalUser(var AMessage: string): boolean;
     337const
     338  TX_NO_AUTH = 'You are not authorized to perform this action.' + CRLF +
     339               'Either the ORES or ORELSE key is required.';
     340begin
     341  Result := (User.UserClass > UC_CLERK);     // User has ORES or ORELSE key
     342  if not Result then AMessage := TX_NO_AUTH else AMessage := '';
     343end;*)
     344
     345function IsARTClinicalUser(var AMessage: string): boolean;
     346const
     347  TX_NO_AUTH = 'You are not authorized to perform this action.' + CRLF;
     348var
     349  x: string;
     350begin
     351  with uARTClinUser do
     352  begin
     353    if not AccessChecked then
     354      begin
     355        x := sCallV('ORWDAL32 CLINUSER',[nil]);
     356        IsClinUser := (Piece(x, U, 1) = '1');
     357        if not IsClinUser then ReasonFailed := TX_NO_AUTH + Piece(x, U, 2) else ReasonFailed := '';
     358        AccessChecked := True;
     359      end;
     360    Result   := IsClinUser;
     361    AMessage := ReasonFailed ;
     362  end;
     363end;
     364
    328365end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/rODBase.pas

    r459 r460  
    6868  end;
    6969
     70  TPFSSActive = record
     71    PFSSActive: boolean;
     72    PFSSChecked: boolean;
     73  end;
     74
    7075{ General Calls }
    7176function AskAnotherOrder(ADialog: Integer): Boolean;
    … …  
    7580procedure LoadDialogDefinition(Dest: TList; const DialogName: string);
    7681procedure LoadOrderPrompting(Dest: TList; ADialog: Integer);
    77 procedure LoadResponses(Dest: TList; const OrderID: string);
     82//procedure LoadResponses(Dest: TList; const OrderID: string);
     83procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
    7884procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string);
    7985//procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer); // no longer used
    … …  
    8894procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string);
    8995procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string);
    90 
     96function IsPFSSActive: boolean;
    9197
    9298{ Quick Order Calls }
    … …  
    126132implementation
    127133
    128 uses TRPCB,uOrders;
     134uses TRPCB, uOrders, uODBase;
    129135
    130136var
    … …  
    133139  uLastQuantityMsg: string;
    134140  uMedRoutes: TStringList;
     141  uPFSSActive: TPFSSActive;
    135142
    136143{ Common Internal Calls }
    … …  
    175182        begin
    176183          IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
    177           TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' hours';
     184          TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'hours';
    178185        end
    179186        else if (Pos('D',upperCase(IVDuration))>0) then
    180187        begin
    181188          IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
    182           TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' days';
     189          TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'days';
    183190        end
    184191        else if ((Pos('ML',upperCase(IVDuration))>0) or (Pos('CC',upperCase(IVDuration))>0)) then
    185192        begin
    186193          IVDurVal := Copy(IVDuration,1,length(IVDuration)-2);
    187           TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + ' ml';
     194          TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + 'ml';
    188195        end
    189196        else if (Pos('L',upperCase(IVDuration))>0) then
    190197        begin
    191198          IVDurVal := Copy(IVDuration,0,length(IVDuration)-1);
    192           TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + ' L';
     199          TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + 'L';
    193200        end;
    194201      end;
    … …  
    371378end;
    372379
    373 procedure ExtractToResponses(Dest: TList);
     380procedure ExtractToResponses(Dest: TList; var HasObjects: boolean);
    374381{ load a list with TResponse records, assumes source strings are in RPCBrokerV.Results }
    375382var
    376383  i: Integer;
    377384  AResponse: TResponse;
     385  WPContainsObjects, TxContainsObjects: boolean;
     386  TempBroker: TStrings;
    378387begin
    379388  i := 0;
    380   with RPCBrokerV do while i < Results.Count do
    381   begin
    382     if CharAt(Results[i], 1) = '~' then
     389  HasObjects := FALSE;
     390  TempBroker := TStringlist.Create;
     391  TempBroker.Assign(RPCBrokerV.Results);
     392  try
     393  with TempBroker do while i < Count do
     394  begin
     395    if CharAt(Strings[i], 1) = '~' then
    383396    begin
    384397      AResponse := TResponse.Create;
    385398      with AResponse do
    386399      begin
    387         PromptIEN := StrToIntDef(Piece(Copy(Results[i], 2, 255), U, 1), 0);
    388         Instance := StrToIntDef(Piece(Results[i], U, 2), 0);
    389         PromptID := Piece(Results[i], U, 3);
     400        PromptIEN := StrToIntDef(Piece(Copy(Strings[i], 2, 255), U, 1), 0);
     401        Instance := StrToIntDef(Piece(Strings[i], U, 2), 0);
     402        PromptID := Piece(Strings[i], U, 3);
    390403        Inc(i);
    391         while (i < Results.Count) and (CharAt(Results[i], 1) <> '~') do
     404        while (i < Count) and (CharAt(Strings[i], 1) <> '~') do
    392405        begin
    393           if CharAt(Results[i], 1) = 'i' then IValue := Copy(Results[i], 2, 255);
    394           if CharAt(Results[i], 1) = 'e' then EValue := Copy(Results[i], 2, 255);
    395           if CharAt(Results[i], 1) = 't' then
     406          if CharAt(Strings[i], 1) = 'i' then IValue := Copy(Strings[i], 2, 255);
     407          if CharAt(Strings[i], 1) = 'e' then EValue := Copy(Strings[i], 2, 255);
     408          if CharAt(Strings[i], 1) = 't' then
    396409          begin
    397410            if Length(EValue) > 0 then EValue := EValue + CRLF;
    398             EValue := EValue + Copy(Results[i], 2, 255);
     411            EValue := EValue + Copy(Strings[i], 2, 255);
    399412            IValue := TX_WPTYPE;  // signals that this is a word processing field
    400413          end;
    401414          Inc(i);
    402415        end; {while i}
     416        if IValue <> TX_WPTYPE then ExpandOrderObjects(IValue, TxContainsObjects);
     417        ExpandOrderObjects(EValue, WPContainsObjects);
     418        HasObjects := HasObjects or WPContainsObjects or TxContainsObjects;
    403419        Dest.Add(AResponse);
    404420      end; {with AResponse}
    405421    end; {if CharAt}
    406422  end; {With RPCBrokerV}
    407 end;
    408 
    409 procedure LoadResponses(Dest: TList; const OrderID: string);
     423  finally
     424    TempBroker.Free;
     425  end;
     426end;
     427
     428procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
    410429begin
    411430  CallV('ORWDX LOADRSP', [OrderID]);
    412   ExtractToResponses(Dest);
     431  ExtractToResponses(Dest, HasObjects);
    413432end;
    414433
    … …  
    427446    Param[1].Value := IntToStr(Encounter.Provider);
    428447    Param[2].PType := literal;
     448    (*if loc > 0 then Param[2].Value := IntToStr(Loc)
     449    else Param[2].Value := IntToStr(Encounter.Location);*)
    429450    Param[2].Value := IntToStr(Encounter.Location);
    430451    Param[3].PType := literal;
    … …  
    659680end;
    660681
     682function IsPFSSActive: boolean;
     683begin
     684  with uPFSSActive do
     685    if not PFSSChecked then
     686      begin
     687        PFSSActive := (sCallV('ORWPFSS IS PFSS ACTIVE?', [nil]) = '1');
     688        PFSSChecked := True;
     689      end;
     690  Result := uPFSSActive.PFSSActive
     691end;
    661692
    662693{ Medication Calls }

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/rODDiet.pas

    r459 r460  
    3131    Alarms: string;
    3232    OPMaxDays: integer;
     33    OPDefaultDiet: integer;
    3334  end;
    3435
    … …  
    3940procedure AppendTFProducts(Dest: TStrings);
    4041function SubSetOfDiets(const StartFrom: string; Direction: Integer): TStrings;
    41 function SubSetOfOPDiets(const StartFrom: string; Direction: Integer): TStrings;
     42function SubSetOfOPDiets: TStrings;
    4243procedure OrderLateTray(NewOrder: TOrder; Meal: Char; const MealTime: string; Bagged: Boolean);
    4344function IsolationID: string;
    … …  
    4849function OutpatientPatchInstalled: boolean;
    4950function UserHasFHAUTHKey: boolean;
     51procedure GetCurrentRecurringOPMeals(Dest: TStrings; MealType: string = '');
     52function OutpatientLocationConfigured(ALocation: string): boolean;
    5053
    5154
    … …  
    9699    else
    97100      OPMaxDays := 30;
     101    if Results.Count > 4 then
     102      OPDefaultDiet := StrToIntDef(Results[4], 0)
    98103  end;
    99104end;
    … …  
    131136end;
    132137
    133 function SubSetOfOPDiets(const StartFrom: string; Direction: Integer): TStrings;
    134 begin
    135   CallV('ORWDFH OPDIETS', [StartFrom, Direction]);
     138function SubSetOfOPDiets: TStrings;
     139begin
     140  CallV('ORWDFH OPDIETS', [nil]);
    136141  Result := RPCBrokerV.Results;
    137142end;
    … …  
    176181    if not PatchChecked then
    177182      begin
    178         PatchInstalled := False;
    179 { TODO -oRich V. -cOutpatient Meals : Uncomment when patch available - need number }
    180         //PatchInstalled := ServerHasPatch('FH_TEST*1.0*1');
     183        //PatchInstalled := True;
     184        { TODO -oRich V. -cOutpatient Meals : Uncomment when available }
     185        PatchInstalled := (PackageVersion('FH') >= '5.5');
    181186        PatchChecked := True;
    182187      end;
    … …  
    195200end;
    196201
     202procedure GetCurrentRecurringOPMeals(Dest: TStrings; MealType: string = '');
     203begin
     204  CallV('ORWDFH CURRENT MEALS', [Patient.DFN, MealType]);
     205  Dest.Assign(RPCBrokerV.Results);
     206  MixedCaseList(Dest);
     207end;
     208
     209function OutpatientLocationConfigured(ALocation: string): boolean;
     210begin
     211  Result := (sCallV('ORWDFH NFSLOC READY', [ALocation]) = '1');
     212end;
     213
    197214end.

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/rODLab.pas

    r459 r460  
    2222procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
    2323function  GetLastCollectionTime: string;
     24procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
     25procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
     26procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
     27function  StatAllowed(PatientID: string): boolean;
     28procedure GetBloodComponents(Dest: TStrings);
    2429
    2530implementation
    … …  
    2732uses  rODBase;
    2833(*    fODBase, rODBase, fODLab;*)
     34
     35procedure GetBloodComponents(Dest: TStrings);
     36begin
     37  tCallV(Dest, 'ORWDXVB COMPORD', []);
     38end;
     39
     40function  StatAllowed(PatientID: string): boolean;
     41begin
     42  Result := (StrToInt(sCallV('ORWDXVB STATALOW',[PatientID])) > 0);
     43end;
     44
     45procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
     46begin
     47  tCallV(Dest, 'ORWDXVB RAW', [PatientID, ATests]);
     48end;
     49
     50procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
     51begin
     52  tCallV(Dest, 'ORWDXVB RESULTS', [PatientID, ATests]);
     53end;
     54
     55procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
     56begin
     57  tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]);
     58end;
    2959
    3060function ODForLab(Location, Division: integer): TStrings;

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/rOrders.pas

    r459 r460  
    3838    ParentID    : string;
    3939    LinkObject:   TObject;
     40    EnteredInError:     Integer; //AGP Changes 26.12 PSI-04-053
    4041    procedure Assign(Source: TOrder);
    4142    procedure Clear;
    … …  
    604605    DGroupSeq  := SeqOfDGroup(DGroup);
    605606    DGroupName := TopNameOfDGroup(DGroup);
     607    //AGP Changes 26.15 PSI-04-063
     608    if (pos('Entered in error',Text)>0) then AnOrder.EnteredInError := 1
     609    else AnOrder.EnteredInError := 0;
    606610    //if DGroupName = 'Non-VA Meds' then Text := 'Non-VA  ' + Text;
    607611  end;
    … …  
    680684  with RPCBrokerV do for i := 1 to Results.Count - 1 do   // if orders found (skip 0 element)
    681685  begin
    682     if (Piece(RPCBrokerV.Results[i], U, 1) = '0') or (Piece(RPCBrokerV.Results[i], U, 1) = '') then Continue;
    683     if (DelimCount(Results[i],U) = 2) then Continue;
     686    if (Piece(RPCBrokerV.Results[i], U, 1) = '0') or (Piece(RPCBrokerV.Results[i], U, 1) = '') then Continue; 
     687    if (DelimCount(Results[i],U) = 2) then Continue; 
    684688    AnOrder := TOrder.Create;
    685689    with AnOrder do
    … …  
    11261130var
    11271131  DelayEvent, x, TheOrder: string;
    1128   Idx,PickupIdx, ForIMOResponses: integer;
     1132  Idx, tmpOrderGroup, PickupIdx, ForIMOResponses: integer;
    11291133  IfUDGrp: Boolean;
    11301134  IfUDGrpForQO: Boolean;
     1135  temp: string;
    11311136begin
    11321137  ForIMOResponses := 0;
     1138  tmpOrderGroup := 0;
     1139  temp := '';
    11331140  if ForIMO then ForIMOResponses := 1;
    11341141  PickupIdx := 0;
    … …  
    11391146  begin
    11401147    Delete(TheOrder,1,1);
    1141     if CheckOrderGroup(TheOrder)=1 then IfUDGrp := True else IfUDGrp := False;
     1148    tmpOrderGroup := CheckOrderGroup(TheOrder);
     1149    if tmpOrderGroup = 1 then IfUDGrp := True else IfUDGrp := False;
    11421150  end;
    11431151  if (not IfUDGrp) and (AnEvent.EventType in ['A','T']) then
    11441152    IfUDGrp := True;
    11451153  //FLDS=DFN^LOC^ORNP^INPT^SEX^AGE^EVENT^SC%^^^Key Variables
     1154  if (Patient.Inpatient = true) and (tmpOrderGroup = 2) then temp := '0';
     1155  if temp <> '0' then temp := BoolChars[Patient.Inpatient];
    11461156  with AnEvent do
    11471157  begin
    … …  
    14511461
    14521462    with RPCBrokerV do
    1453        begin
    1454          ClearParameters := True;
    1455          RemoteProcedure := 'ORWDXR RENEW';
    1456          Param[0].PType := literal;
    1457          Param[0].Value := AnOrder.ID;
    1458          Param[1].PType := literal;
    1459          Param[1].Value := Patient.DFN;
    1460          Param[2].PType := literal;
    1461          Param[2].Value := IntToStr(Encounter.Provider);
    1462          Param[3].PType := literal;
    1463          Param[3].Value := IntToStr(Encounter.Location);
    1464          Param[4].PType := list;
    1465 
    1466          for i := 0 to tmplst.Count - 1 do
    1467            Param[4].Mult[IntToStr(i+1)] := tmplst[i];
    1468 
    1469          Param[4].Mult['"ORCHECK"'] := IntToStr(OCList.Count);
    1470 
    1471          for i := 0 to OCList.Count - 1 do
    1472          begin
    1473            // put quotes around everything to prevent broker from choking
    1474            y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) + '","' + IntToStr(i+1) + '"';
    1475            Param[4].Mult[y] := Pieces(OCList[i], U, 2, 4);
    1476          end;
    1477          Param[5].PType := literal;
    1478          Param[5].Value := IntToStr(IsComplex);
    1479          Param[6].PType := literal;
    1480          Param[6].Value := FloatToStr(AnIMOOrderAppt);
    1481 
     1463    begin
     1464      ClearParameters := True;
     1465      RemoteProcedure := 'ORWDXR RENEW';
     1466      Param[0].PType := literal;
     1467      Param[0].Value := AnOrder.ID;
     1468      Param[1].PType := literal;
     1469      Param[1].Value := Patient.DFN;
     1470      Param[2].PType := literal;
     1471      Param[2].Value := IntToStr(Encounter.Provider);
     1472      Param[3].PType := literal;
     1473      Param[3].Value := IntToStr(Encounter.Location);
     1474      Param[4].PType := list;
     1475      for i := 0 to tmplst.Count - 1 do
     1476        Param[4].Mult[IntToStr(i+1)] := tmplst[i];
     1477      Param[4].Mult['"ORCHECK"'] := IntToStr(OCList.Count);
     1478      for i := 0 to OCList.Count - 1 do
     1479      begin
     1480      // put quotes around everything to prevent broker from choking
     1481      y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) +
     1482        '","' + IntToStr(i+1) + '"';
     1483      Param[4].Mult[y] := Pieces(OCList[i], U, 2, 4);
     1484    end;
     1485    Param[5].PType := literal;
     1486    Param[5].Value := IntToStr(IsComplex);
     1487    Param[6].PType := literal;
     1488    Param[6].Value := FloatToStr(AnIMOOrderAppt);
    14821489    CallBroker;
    14831490    SetOrderFromResults(AnOrder);
    … …  
    15101517  CallV('ORWDXA DCREASON', [nil]);
    15111518  ExtractItems(Dest, RPCBrokerV.Results, 'DCReason');
    1512   DefaultIEN := StrToIntDef(Piece(ExtractDefault(RPCBrokerV.Results, 'DCReason'), U, 1), 0);
     1519  //AGP Change 26.15 for PSI-04-63
     1520  //DefaultIEN := StrToIntDef(Piece(ExtractDefault(RPCBrokerV.Results, 'DCReason'), U, 1), 0);
    15131521end;
    15141522
    … …  
    15281536  SetOrderFromResults(AnOrder);
    15291537  AnOrder.ParentID := AParentID;
    1530 
    15311538end;
    15321539

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/uODBase.pas

    r459 r460  
    2222procedure PopKeyVars(NumLevels: Integer = 1);
    2323procedure PushKeyVars(const NewVals: string);
     24procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
    2425
    2526implementation
     27
     28uses
     29  dShared, Windows, rTemplates;
    2630
    2731var
    … …  
    118122end;
    119123
     124procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
     125var
     126  ObjList: TStringList;
     127  Err: TStringList;
     128  i, j, k, oLen: integer;
     129  obj, ObjTxt: string;
     130const
     131  CRDelim = #13;
     132  TC_BOILER_ERR  = 'Order Boilerplate Object Error';
     133  TX_BOILER_ERR  = 'Contact IRM and inform them about this error.' + CRLF +
     134                   'Make sure you give them the name of the quick' + CRLF +
     135                   'order that you are processing.' ;
     136begin
     137  ObjList := TStringList.Create;
     138  try
     139    Err := nil;
     140    if(not dmodShared.BoilerplateOK(Txt, CRDelim, ObjList, Err)) and (assigned(Err)) then
     141    begin
     142      try
     143        Err.Add(CRLF + TX_BOILER_ERR);
     144        InfoBox(Err.Text, TC_BOILER_ERR, MB_OK + MB_ICONERROR);
     145      finally
     146        Err.Free;
     147      end;
     148    end;
     149    if(ObjList.Count > 0) then
     150    begin
     151      ContainsObjects := True;
     152      GetTemplateText(ObjList);
     153      i := 0;
     154      while (i < ObjList.Count) do
     155      begin
     156        if(pos(ObjMarker, ObjList[i]) = 1) then
     157        begin
     158          obj := copy(ObjList[i], ObjMarkerLen+1, MaxInt);
     159          if(obj = '') then break;
     160          j := i + 1;
     161          while (j < ObjList.Count) and (pos(ObjMarker, ObjList[j]) = 0) do
     162            inc(j);
     163          if((j - i) > 2) then
     164          begin
     165            ObjTxt := '';
     166            for k := i+1 to j-1 do
     167              ObjTxt := ObjTxt + #13 + ObjList[k];
     168          end
     169          else
     170            ObjTxt := ObjList[i+1];
     171          i := j;
     172          obj := '|' + obj + '|';
     173          oLen := length(obj);
     174          repeat
     175            j := pos(obj, Txt);
     176            if(j > 0) then
     177            begin
     178              delete(Txt, j, OLen);
     179              insert(ObjTxt, Txt, j);
     180            end;
     181          until(j = 0);
     182        end
     183        else
     184          inc(i);
     185      end
     186    end;
     187  finally
     188    ObjList.Free;
     189  end;
     190end;
     191
    120192initialization
    121193  uOrderEventType := #0;

  • cprs/branches/foia-cprs/CPRS-Chart/Orders/uOrders.pas

    r459 r460  
    5858procedure QuickOrderListEdit;
    5959function RefNumFor(AnOwner: TComponent): Integer;
    60 procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char);
     60procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
    6161procedure SetFontSize( FontSize: integer);
    6262procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
    … …  
    7474MedsDisp : Integer;
    7575ClinDisp : Integer; //IMO
     76NurDisp  : Integer;
    7677IVDisp   : Integer;
    7778CsltDisp : Integer;
    7879ProcDisp : Integer;
     80ImgDisp  : Integer;
    7981NonVADisp: Integer;
    8082MedsInDlgIen  : Integer;
    … …  
    9496
    9597uses fODDiet, fODMisc, fODGen, fODMedIn, fODMedOut, fODText, fODConsult, fODProc, fODRad,
    96      fODLab, fODMeds, fODMedIV, fODVitals, fODAuto, fODAllgy, fOMNavA, rCore, uCore, fFrame,
     98     fODLab, fodBBank, fODMeds, fODMedIV, fODVitals, fODAuto, (*fODAllgy,*) fOMNavA, rCore, uCore, fFrame,
    9799     fEncnt, fEffectDate, fOMVerify, fOrderSaveQuick, fOMSet, rMisc, uODBase, rODMeds,
    98100     fLkUpLocation, fOrdersPrint, fOMAction, fARTAllgy, fOMHTML, fOrders, rODBase,
    99101     fODChild, fMeds, rMeds, rPCE, frptBox, fODMedNVA, fODChangeUnreleasedRenew, rODAllergy,
    100      UBAGlobals;
     102     UBAGlobals, fClinicWardMeds, uTemplateFields;
    101103
    102104var
    … …  
    142144  TX_NO_QUICK   = 'This ordering dialog does not support quick orders.';
    143145  TC_NO_QUICK   = 'Save/Edit Quick Orders';
     146  TX_CANT_SAVE_QO = 'This order contains TIU objects, which may result in patient-specific' + CRLF +
     147                    'information being included in the order.  For this reason, it may not' + CRLF +
     148                    'be saved as a personal quick order for later reuse.';
    144149  TX_NO_COPY    = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ';
    145150  TC_NO_COPY    = 'Unable to Copy Order';
    … …  
    152157  STEP_FORWARD  = 1;
    153158  STEP_BACK     = -1;
    154   TX_NOINPT     = 'You can not place inpatient medication order on a clinic location for selected inpatient.';
     159  TX_NOINPT     = ': You cannot place inpatient medication orders from a clinic location for selected patient.';
    155160  TX_IMO_WARNING1 = 'You are ';
    156   TX_IMO_WARNING2 = ' Clinic Medication orders. The New orders will be saved as Clinic Medication orders and will NOT be available in BCMA';
     161  TX_IMO_WARNING2 = ' Clinic Orders. The New orders will be saved as Clinic Orders and MAY NOT be available in BCMA';
    157162
    158163
    … …  
    200205  OD_DIET:      DialogClass := TfrmODDiet;
    201206  OD_LAB:       DialogClass := TfrmODLab;
     207  OD_BB:        DialogClass := TfrmODBBank;
    202208  OD_CONSULT:   DialogClass := TfrmODCslt;
    203209  OD_PROCEDURE: DialogClass := TfrmODProc;
    204210  OD_TEXTONLY:  DialogClass := TfrmODText;
    205211  OD_VITALS:    DialogClass := TfrmODVitals;
    206   OD_ALLERGY:   DialogClass := TfrmODAllergy;
     212  //OD_ALLERGY:   DialogClass := TfrmODAllergy;
    207213  OD_AUTOACK:   DialogClass := TfrmODAuto;
    208214  else Exit;
    … …  
    391397      else
    392398      begin
    393         ResolvedDialog.DisplayGroup := InptDisp;
    394         ResolvedDialog.DialogIEN    := MedsInDlgIen;
    395         ResolvedDialog.FormID       := MedsInDlgFormId;
     399        //AGP changes to handle IMO INV Dialog opening the unit dose dialog.
     400        if (ResolvedDialog.DisplayGroup = ClinDisp) and (Resolveddialog.DialogIEN = MedsIVDlgIEN) and (ResolvedDialog.FormID = MedsIVDlgFormId) then
     401          begin
     402            ResolvedDialog.DisplayGroup := IVDisp;
     403            ResolvedDialog.DialogIEN    := MedsIVDlgIen;
     404            ResolvedDialog.FormID       := MedsIVDlgFormId;
     405          end
     406        else
     407          begin
     408            ResolvedDialog.DisplayGroup := InptDisp;
     409            ResolvedDialog.DialogIEN    := MedsInDlgIen;
     410            ResolvedDialog.FormID       := MedsInDlgFormId;
     411          end;
    396412        if Length(ResolvedDialog.ShowText)>0 then
    397413          ResolvedDialog.QuickLevel   := 2;
    … …  
    452468  IVDisp   := DisplayGroupByName('IV RX');
    453469  ClinDisp := DisplayGroupByName('C RX');
     470  NurDisp  := DisplayGroupByName('NURS');
    454471  CsltDisp := DisplayGroupByName('CSLT');
    455472  ProcDisp := DisplayGroupByName('PROC');
     473  ImgDisp  := DisplayGroupByName('XRAY');
    456474  NonVADisp := DisplayGroupByName('NV RX');
    457475  MedsInDlgIen  := DlgIENForName('PSJ OR PAT OE');
    … …  
    817835    ResolvedDialog.DisplayGroup := ClinDisp;
    818836  ResetDialogProperties(AnID, AnEvent, ResolvedDialog);
     837 {* AGP CHANGE 26.20 Remove restriction to allowed for ordering of inpatient medication for an inpatient from an outpatient location
    819838   //jd imo change
    820839   if (ResolvedDialog.DisplayGroup = InptDisp) and (Patient.Inpatient) and (AnEvent.EventIFN < 1) then
    … …  
    826845     end;
    827846   end;
    828    //jd imo change end
     847   //jd imo change end  *}
    829848   if (ResolvedDialog.DisplayGroup = InptDisp) or
    830849      (ResolvedDialog.DisplayGroup = OutptDisp) or
    … …  
    865884    if NSSchedule then ResolvedDialog.QuickLevel := 0;
    866885  end;
     886  with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG;
    867887  with ResolvedDialog do
    868888  begin
    … …  
    10031023                       begin
    10041024                       ShowModal;
    1005                        //Application.ProcessMessages;
    10061025                       Result := uOrderDialog.AcceptOK;
    10071026                       uOrderDialog.Destroy;
    … …  
    10101029                       begin
    10111030                       Show;
    1012                        //Application.ProcessMessages;
    10131031                       Result := True;
    10141032                       end;
    … …  
    10501068  OrdList: TList;
    10511069  theOrder: TOrder;
    1052 begin
     1070 // i: integer;
     1071begin
     1072 // if Assigned(OrdList) then
     1073 // begin
     1074 //    for i := 0 to pred(OrdList.Count) do
     1075 //       TObject(OrdList[i]).Free;
     1076  //   UBAGlobals.tempDxList := nil;
     1077 // end;
    10531078  OrdList := TList.Create;
    10541079  theOrder := TOrder.Create;
    … …  
    10571082  RetrieveOrderFields(OrdList, 0, 0);
    10581083  Result := TOrder(OrdList.Items[0]).Text;
     1084  if Assigned(OrdList) then OrdList.Free; //CQ:7554
    10591085end;
    10601086
    … …  
    13491375        param2 := FieldsForEditRenewOrder.StopTime;
    13501376      end;
    1351        UBAGlobals.SourceOrderID := AList[i]; //hds6265 added
     1377      UBAGlobals.SourceOrderID := AList[i]; //hds6265 added
    13521378      ExecuteChangeRenewedOrder(AList[i], param1, param2, txtOrder);
    13531379      AnOrder := TOrder.Create;
    … …  
    13931419var
    13941420  i: Integer;
    1395   xx,xy: string;
     1421  xx: string;
    13961422  IsIMOOD,ForIVAlso: boolean;
    13971423begin
    … …  
    16021628      Exit;
    16031629    end;
     1630    if Responses.OrderContainsObjects then
     1631    begin
     1632      InfoBox(TX_CANT_SAVE_QO, TC_NO_QUICK, MB_ICONERROR or MB_OK);
     1633      Exit;
     1634    end;
    16041635    SaveAsQuickOrder(Responses);
    16051636  end;
    … …  
    16391670
    16401671
    1641 procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char);
     1672procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
    16421673const
    16431674  TX_NEW_LOC1   = 'The patient''s location has changed to ';
    … …  
    16521683  PrintIt: Boolean;
    16531684begin
    1654   CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
    1655   if (ALocation > 0) and (ALocation <> Encounter.Location) then
    1656   begin
    1657     Encounter.Location := ALocation;
    1658     if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES
    1659       then Encounter.Location := ALocation;
    1660   end;
     1685  if PrintLoc = 0 then
     1686    begin
     1687      CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
     1688      if (ALocation > 0) and (ALocation <> Encounter.Location) then
     1689        begin
     1690          if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES
     1691          then Encounter.Location := ALocation;
     1692        end;
     1693    end
     1694  else
     1695    Encounter.Location := PrintLoc;
    16611696  if Encounter.Location = 0
    16621697    then Encounter.Location := CommonLocationForOrders(OrderList);
    … …  
    17471782        if CharAt(AnID,1) = 'X' then actName := 'change';
    17481783        if CharAt(AnID,1) = 'C' then actName := 'copy';
    1749         x := 'You can not ' + actName + ' the clinical medication order.';
     1784        x := 'You cannot ' + actName + ' the clinical medication order.';
    17501785        x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#13#10 + x;
    17511786        UnlockOrder(Copy(AnID, 2, Length(AnID)));
    … …  
    17741809      if (not AllowActionOnIMO(AnEventType)) then
    17751810      begin
    1776         x := 'You can not renew the the clinical medication order.';
     1811        x := 'You cannot renew the clinical medication order.';
    17771812        x := RetrieveOrderText(Piece(AnID,'^',2)) + #13#13#10 + x;
    17781813        UnlockOrder(Piece(AnID,'^',2));
    … …  
    18091844  OriginalMedsInHeight    := 0;
    18101845  OriginalNonVAMedsHeight := 0;
     1846
    18111847end.
Note: See TracChangeset for help on using the changeset viewer.