Module

fConsultBSt

Path

C:\CPRS\CPRS30\Consults\fConsultBSt.pas

Last Modified

7/15/2014 3:26:34 PM

Units Used in Interface

Name Comments
fBase508Form -
uConsults -

Units Used in Implementation

Name Comments
rConsults -
rCore -
uCore -

Classes

Name Comments
TfrmConsultsByStatus -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmConsultsByStatus procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmConsultsByStatus procedure cmdOKClick(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
SelectStatus - function SelectStatus(FontSize: Integer; CurrentContext: TSelectContext; var StatusContext: TStatusContext): boolean ; Interfaced Displays Status select form for consults and returns a record of the selection

Constants

Name Declaration Scope Comments
TX_STAT_CAP 'Missing Status' Global -
TX_STAT_TEXT 'Select a consult status or press Cancel.' Global -


Module Source

1     unit fConsultBSt;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmConsultsByStatus = class(TfrmBase508Form)
12        pnlBase: TORAutoPanel;
13        lblStatus: TLabel;
14        radSort: TRadioGroup;
15        lstStatus: TORListBox;
16        cmdOK: TButton;
17        cmdCancel: TButton;
18        procedure cmdCancelClick(Sender: TObject);
19        procedure cmdOKClick(Sender: TObject);
20      private
21        FChanged: Boolean;
22        FStatus: string;
23        FStatusName: string;
24        FAscending: Boolean;
25      end;
26    
27      TStatusContext = record
28        Changed: Boolean;
29        Status: string;
30        StatusName: string;
31        Ascending: Boolean;
32      end;
33    
34    function SelectStatus(FontSize: Integer; CurrentContext: TSelectContext; var StatusContext: TStatusContext): boolean ;
35    
36    implementation
37    
38    {$R *.DFM}
39    
40    uses rConsults, rCore, uCore;
41    
42    const
43      TX_STAT_TEXT = 'Select a consult status or press Cancel.';
44      TX_STAT_CAP = 'Missing Status';
45    
46    function SelectStatus(FontSize: Integer; CurrentContext: TSelectContext; var StatusContext: TStatusContext): boolean ;
47    { displays Status select form for consults and returns a record of the selection }
48    var
49      frmConsultsByStatus: TfrmConsultsByStatus;
50      W, H, i, j: Integer;
51      CurrentStatus: string;
52    begin
53      frmConsultsByStatus := TfrmConsultsByStatus.Create(Application);
54      try
55        with frmConsultsByStatus do
56        begin
57          Font.Size := FontSize;
58          W := ClientWidth;
59          H := ClientHeight;
60          ResizeToFont(FontSize, W, H);
61          ClientWidth  := W; pnlBase.Width  := W;
62          ClientHeight := H; pnlBase.Height := H;
63          FChanged := False;
64          with radSort do {if SortConsultsAscending then ItemIndex := 0 else} ItemIndex := 1;
65          FastAssign(SubSetOfStatus, lstStatus.Items);
66          CurrentStatus := CurrentContext.Status;
67          if CurrentStatus <> '' then with lstStatus do
68            begin
69              i := 1;
70              while Piece(CurrentStatus, ',', i) <> '' do
71                begin
72                  j := SelectByID(Piece(CurrentStatus, ',', i));
73                  if j > -1 then Selected[j] := True;
74                  Inc(i);
75                end;
76            end;
77          ShowModal;
78          with StatusContext do
79          begin
80            Changed := FChanged;
81            Status := FStatus;
82            StatusName := FStatusName;
83            Ascending := FAscending;
84            Result := Changed ;
85          end; {with StatusContext}
86        end; {with frmConsultsByStatus}
87      finally
88        frmConsultsByStatus.Release;
89      end;
90    end;
91    
92    procedure TfrmConsultsByStatus.cmdCancelClick(Sender: TObject);
93    begin
94      Close;
95    end;
96    
97    procedure TfrmConsultsByStatus.cmdOKClick(Sender: TObject);
98    var
99      i: integer;
100   begin
101     if lstStatus.SelCount = 0 then
102      begin
103       InfoBox(TX_STAT_TEXT, TX_STAT_CAP, MB_OK or MB_ICONWARNING);
104       Exit;
105      end;
106     FChanged := True;
107     with lstStatus do for i := 0 to Items.Count-1 do if Selected[i] then
108       begin
109         if Piece(Items[i], U, 1) <> '999' then
110           FStatus := FStatus + Piece(Items[i], U, 1) + ','
111         else
112           FStatus := FStatus + Piece(Items[i],U,3) ;
113         FStatusName := FStatusName + DisplayText[i] + ',' ;
114       end;
115     FStatus := Copy(FStatus, 1, Length(FStatus)-1);
116     FStatusName := Copy(FStatusName, 1, Length(FStatusName)-1);
117     FAscending  := radSort.ItemIndex = 0;
118     Close;
119   end;
120   
121   end.

Module Calls (2 levels)


fConsultBSt
 ├uConsults
 │ └uConst
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 └rConsults
   ├rCore
   ├uCore
   ├uConsults...
   └uTIU

Module Called-By (2 levels)


        fConsultBSt
        fConsults┘ 
         fFrame┤   
         fNotes┤   
     fPrintList┤   
fReminderDialog┤   
        fReview┤   
       fSurgery┤   
    fConsultAct┤   
      fCsltNote┘