Module

fConsMedRslt

Path

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

Last Modified

7/15/2014 3:26:34 PM

Units Used in Interface

Name Comments
fAutoSz -
fConsultAlertTo -
fRptBox -

Units Used in Implementation

Name Comments
rConsults -
rCore -
uConst -
uCore -

Classes

Name Comments
TfrmConsMedRslt -

Procedures

Name Owner Declaration Scope Comments
ckAlertClick TfrmConsMedRslt procedure ckAlertClick(Sender: TObject); Public/Published -
cmdCancelClick TfrmConsMedRslt procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdDetailsClick TfrmConsMedRslt procedure cmdDetailsClick(Sender: TObject); Public/Published MsgString, HasImages: string;
cmdOKClick TfrmConsMedRslt procedure cmdOKClick(Sender: TObject); Public/Published -
FormDestroy TfrmConsMedRslt procedure FormDestroy(Sender: TObject); Public/Published -
lstMedResultsDrawItem TfrmConsMedRslt procedure lstMedResultsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
NewPersonNeedData TfrmConsMedRslt procedure NewPersonNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
ShowDetailsDestroyed TfrmConsMedRslt procedure ShowDetailsDestroyed(Sender: TObject); Protected -

Functions

Name Owner Declaration Scope Comments
SelectMedicineResult - function SelectMedicineResult(ConsultIEN: integer; FormTitle: string; var MedResult: TMedResultRec): boolean ; Interfaced Displays Medicine Result selection form and returns a record of the selection

Global Variables

Name Type Declaration Comments
RecipientList RecipientList: TRecipientList ; -

Constants

Name Declaration Scope Comments
TX_MEDRSLT_CAP 'No Result Selected' Global -
TX_MEDRSLT_TEXT 'Select medicine result or press Cancel.' Global -


Module Source

1     unit fConsMedRslt;
2     
3     interface
4     
5     uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 
6       Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox,
7       VA508AccessibilityManager;
8     
9     type
10      TMedResultRec = record
11        Action: string;
12        ResultPtr: string;
13        DateTimeofAction: TFMDateTime;
14        ResponsiblePerson: Int64;
15        AlertsTo: TRecipientList;
16      end;
17    
18      TfrmConsMedRslt = class(TfrmAutoSz)
19        cmdOK: TButton;
20        cmdCancel: TButton;
21        lstMedResults: TORListBox;
22        SrcLabel: TLabel;
23        pnlBase: TORAutoPanel;
24        cmdDetails: TButton;
25        ckAlert: TCheckBox;
26        lblDateofAction: TOROffsetLabel;
27        calDateofAction: TORDateBox;
28        lblActionBy: TOROffsetLabel;
29        cboPerson: TORComboBox;
30        lblResultName: TOROffsetLabel;
31        lblResultDate: TOROffsetLabel;
32        lblSummary: TOROffsetLabel;
33        procedure cmdOKClick(Sender: TObject);
34        procedure cmdCancelClick(Sender: TObject);
35        procedure cmdDetailsClick(Sender: TObject);
36        procedure ckAlertClick(Sender: TObject);
37        procedure NewPersonNeedData(Sender: TObject; const StartFrom: String;
38          Direction, InsertAt: Integer);
39        procedure FormDestroy(Sender: TObject);
40        procedure lstMedResultsDrawItem(Control: TWinControl; Index: Integer;
41          Rect: TRect; State: TOwnerDrawState);
42      protected
43        procedure ShowDetailsDestroyed(Sender: TObject);
44      private
45        FShowDetails: TfrmReportBox;
46        FOldShowDetailsOnDestroy: TNotifyEvent;
47        FMedResult: TMedResultRec ;
48        FChanged: Boolean;
49      end;
50    
51    function SelectMedicineResult(ConsultIEN: integer; FormTitle: string; var MedResult: TMedResultRec): boolean ;
52    
53    implementation
54    
55    {$R *.DFM}
56    
57    uses rConsults, rCore, uCore, uConst;
58    
59    const
60      TX_MEDRSLT_TEXT = 'Select medicine result or press Cancel.';
61      TX_MEDRSLT_CAP  = 'No Result Selected';
62    
63    var
64      RecipientList: TRecipientList ;
65    
66    function SelectMedicineResult(ConsultIEN: integer; FormTitle: string; var MedResult: TMedResultRec): boolean ;
67    { displays Medicine Result selection form and returns a record of the selection }
68    var
69      frmConsMedRslt: TfrmConsMedRslt;
70    begin
71      frmConsMedRslt := TfrmConsMedRslt.Create(Application);
72      try
73        with frmConsMedRslt do
74        begin
75          FChanged := False;
76          FillChar(RecipientList, SizeOf(RecipientList), 0);
77          FillChar(FMedResult, SizeOf(FMedResult), 0);
78          Caption := FormTitle;
79          cboPerson.InitLongList(User.Name);
80          cboPerson.SelectByIEN(User.DUZ);
81          ResizeFormToFont(TForm(frmConsMedRslt));
82    
83          if MedResult.Action = 'ATTACH' then
84            begin
85              FastAssign(GetAssignableMedResults(ConsultIEN), lstMedResults.Items);
86              ckAlert.Visible := True;
87            end
88          else if MedResult.Action = 'REMOVE' then
89            begin
90              FastAssign(GetRemovableMedResults(ConsultIEN), lstMedResults.Items);
91              ckAlert.Visible := False;
92            end;
93          if lstMedResults.Items.Count > 0 then
94            ShowModal
95          else
96            FChanged := True;
97          Result := FChanged;
98          MedResult := FMedResult;
99        end; {with frmODConsMedRslt}
100     finally
101       frmConsMedRslt.Release;
102     end;
103   end;
104   
105   procedure TfrmConsMedRslt.cmdCancelClick(Sender: TObject);
106   begin
107     FillChar(FMedResult, SizeOf(FMedResult), 0);
108     FChanged := False;
109     Close;
110   end;
111   
112   procedure TfrmConsMedRslt.cmdOKClick(Sender: TObject);
113   begin
114     FillChar(FMedResult, SizeOf(FMedResult), 0);
115     if lstMedResults.ItemIndex = -1 then
116     begin
117       InfoBox(TX_MEDRSLT_TEXT, TX_MEDRSLT_CAP, MB_OK or MB_ICONWARNING);
118       FChanged := False ;
119       Exit;
120     end;
121     FChanged := True;
122     with FMedResult do
123       begin
124         ResultPtr := lstMedResults.ItemID ;
125         DateTimeofAction := calDateOfAction.FMDateTime;
126         ResponsiblePerson := cboPerson.ItemIEN;
127         AlertsTo := RecipientList;
128       end;
129     Close;
130   end;
131   
132   procedure TfrmConsMedRslt.cmdDetailsClick(Sender: TObject);
133   const
134     TX_RESULTS_CAP = 'Detailed Results Display';
135   var
136     x: string;
137     //MsgString, HasImages: string;
138   begin
139     inherited;
140     if lstMedResults.ItemIndex = -1 then exit;
141     x := Piece(Piece(Piece(lstMedResults.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstMedResults.ItemID, ';', 1);
142     // ---------------------------------------------------------------
143     // Don't do this until MED API is changed for new/unassigned results, or false '0' will be broadcast
144   (*  MsgString := 'MED^' + x;
145     HasImages := BOOLCHAR[StrToIntDef(Piece(x, U, 5), 0) > 0];
146     SetPiece(HasImages, U, 10, HasImages);
147     NotifyOtherApps(NAE_REPORT, MsgString);*)
148     // ---------------------------------------------------------------
149     NotifyOtherApps(NAE_REPORT, 'MED^' + x);
150     if(not assigned(FShowDetails)) then
151     begin
152       FShowDetails := ModelessReportBox(GetDetailedMedicineResults(lstMedResults.ItemID), TX_RESULTS_CAP, True);
153       FOldShowDetailsOnDestroy := FShowDetails.OnDestroy;
154       FShowDetails.OnDestroy := ShowDetailsDestroyed;
155       cmdDetails.Enabled := (not assigned(FShowDetails));
156       lstMedResults.Enabled := (not assigned(FShowDetails));
157     end;
158   end;
159   
160   procedure TfrmConsMedRslt.ShowDetailsDestroyed(Sender: TObject);
161   begin
162     if(assigned(FOldShowDetailsOnDestroy)) then
163       FOldShowDetailsOnDestroy(Sender);
164     FShowDetails := nil;
165     cmdDetails.Enabled := (not assigned(FShowDetails));
166     lstMedResults.Enabled := (not assigned(FShowDetails));
167   end;
168   
169   
170   procedure TfrmConsMedRslt.ckAlertClick(Sender: TObject);
171   begin
172     FillChar(RecipientList, SizeOf(RecipientList), 0);
173     if ckAlert.Checked then SelectRecipients(Font.Size, 0, RecipientList) ;
174   end;
175   
176   procedure TfrmConsMedRslt.NewPersonNeedData(Sender: TObject; const StartFrom: string;
177     Direction, InsertAt: Integer);
178   begin
179     inherited;
180     (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
181   end;
182   
183   procedure TfrmConsMedRslt.FormDestroy(Sender: TObject);
184   begin
185     inherited;
186     KillObj(@FShowDetails);
187   end;
188   
189   procedure TfrmConsMedRslt.lstMedResultsDrawItem(Control: TWinControl;
190     Index: Integer; Rect: TRect; State: TOwnerDrawState);
191   var
192     x: string;
193     AnImage: TBitMap;
194   const
195     STD_PROC_TEXT = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
196     STD_DATE = 'MMM DD,YY@HH:NNXX';
197   begin
198     inherited;
199     AnImage := TBitMap.Create;
200     try
201       with (Control as TORListBox).Canvas do  { draw on control canvas, not on the form }
202         begin
203           x := (Control as TORListBox).Items[Index];
204           FillRect(Rect);       { clear the rectangle }
205           AnImage.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1');
206           (Control as TORListBox).ItemHeight := HigherOf(TextHeight(x), AnImage.Height);
207           if StrToIntDef(Piece(x, U, 5), 0) > 0 then
208             begin
209               BrushCopy(Bounds(Rect.Left, Rect.Top, AnImage.Width, AnImage.Height),
210                 AnImage, Bounds(0, 0, AnImage.Width, AnImage.Height), clRed); {render ImageFlag}
211             end;
212           TextOut(Rect.Left + AnImage.Width, Rect.Top, Piece(x, U, 2));
213           TextOut(Rect.Left + AnImage.Width + TextWidth(STD_PROC_TEXT), Rect.Top, Piece(x, U, 3));
214           TextOut(Rect.Left + AnImage.Width + TextWidth(STD_PROC_TEXT) + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 4));
215         end;
216     finally
217       AnImage.Free;
218     end;
219   end;
220   
221   end.

Module Calls (2 levels)


fConsMedRslt
 ├fAutoSz
 │ └fBase508Form
 ├fConsultAlertTo
 │ ├fBase508Form...
 │ └rCore
 ├fRptBox
 │ ├fFrame
 │ ├fBase508Form...
 │ ├uReports
 │ └rReports
 ├rConsults
 │ ├rCore...
 │ ├uCore
 │ ├uConsults
 │ └uTIU
 ├rCore...
 ├uCore...
 └uConst

Module Called-By (2 levels)


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