Module

fODGen

Path

C:\CPRS\CPRS30\Orders\fODGen.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fBase508Form -
fODBase -
rODBase -

Units Used in Implementation

Name Comments
rCore -
rOrders -
uConst -

Classes

Name Comments
TDialogCtrl -
TfrmODGen -

Procedures

Name Owner Declaration Scope Comments
cmdAcceptClick TfrmODGen procedure cmdAcceptClick(Sender: TObject); Public/Published -
ControlChange TfrmODGen procedure ControlChange(Sender: TObject); Private -
FormClose TfrmODGen procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmODGen procedure FormCreate(Sender: TObject); Public/Published -
InitDialog TfrmODGen procedure InitDialog; override; Protected -
LookupNeedData TfrmODGen procedure LookupNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); Private -
PlaceControls TfrmODGen procedure PlaceControls; Private -
PlaceDateTime TfrmODGen procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer); Private -
PlaceFreeText TfrmODGen procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer); Private -
PlaceHidden TfrmODGen procedure PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); Private -
PlaceLabel TfrmODGen procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); Private -
PlaceLookup TfrmODGen procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer); Private -
PlaceMemo TfrmODGen procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer); Private -
PlaceNumeric TfrmODGen procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer); Private -
PlaceSetOfCodes TfrmODGen procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer); Private -
PlaceYesNo TfrmODGen procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer); Private -
SetComponentName TfrmODGen procedure SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl); Private -
SetDialogIEN TfrmODGen procedure SetDialogIEN(Value: Integer); override; Protected Sets up a generic ordering dialog on the fly. Called before SetupDialog.
SetError - procedure SetError(const x: string); Local -
SetupDialog TfrmODGen procedure SetupDialog(OrderAction: Integer; const ID: string); override; Public -
TrimAllMemos TfrmODGen procedure TrimAllMemos; Private -
UpdateAccessibilityActions TfrmODGen procedure UpdateAccessibilityActions(var Actions: TAccessibilityActions); override; Protected -
VA508CompMemOrderStateQuery TfrmODGen procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string); Public/Published -
Validate TfrmODGen procedure Validate(var AnErrMsg: string); override; Protected -

Global Variables

Name Type Declaration Comments
frmODGen TfrmODGen frmODGen: TfrmODGen; -

Constants

Name Declaration Scope Comments
HT_FRAME 8 Global -
HT_LBLOFF 3 Global -
HT_SPACE 6 Global -
TX_STOPSTART 'The stop date must be after the start date.' Global -
WD_MARGIN 6 Global -


Module Source

1     unit fODGen;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fODBase, ComCtrls, ExtCtrls, StdCtrls, ORDtTm, ORCtrls, ORFn, rODBase, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TDialogCtrl = class
12        ID: string;
13        DataType: Char;
14        Required: Boolean;
15        Preserve: Boolean;
16        Prompt: TStaticText;
17        Editor: TWinControl;
18        IHidden: string;
19        EHidden: string;
20      end;
21    
22      TfrmODGen = class(TfrmODBase)
23        sbxMain: TScrollBox;
24        lblOrderSig: TLabel;
25        VA508CompMemOrder: TVA508ComponentAccessibility;
26        procedure FormCreate(Sender: TObject);
27        procedure FormClose(Sender: TObject; var Action: TCloseAction);
28        procedure cmdAcceptClick(Sender: TObject);
29        procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
30      private
31        FilterOut: boolean;
32        TsID: string; //treating specialty id
33        TSDomain: string;
34        AttendID: string;
35        AttendDomain: string;
36        procedure ControlChange(Sender: TObject);
37        procedure LookupNeedData(Sender: TObject; const StartFrom: string;
38          Direction, InsertAt: Integer);
39        procedure PlaceControls;
40        procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
41        procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
42        procedure PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
43        procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
44        procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
45        procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
46        procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
47        procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
48        procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
49        procedure TrimAllMemos;
50        procedure SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl);
51      protected
52        FFormCloseCalled : Boolean;
53        FCharHt: Integer;
54        FCharWd: Integer;
55        FDialogItemList: TList;
56        FDialogCtrlList: TList;
57        FEditorLeft: Integer;
58        FEditorTop: Integer;
59        FFirstCtrl: TWinControl;
60        FLabelWd: Integer;
61        procedure InitDialog; override;
62        procedure SetDialogIEN(Value: Integer); override;
63        procedure Validate(var AnErrMsg: string); override;
64        procedure UpdateAccessibilityActions(var Actions: TAccessibilityActions); override;
65      public
66        procedure SetupDialog(OrderAction: Integer; const ID: string); override;
67      end;
68    
69    var
70      frmODGen: TfrmODGen;
71    
72    implementation
73    
74    {$R *.DFM}
75    
76    uses rCore, rOrders, uConst;
77    
78    const
79      HT_FRAME  = 8;
80      HT_LBLOFF = 3;
81      HT_SPACE  = 6;
82      WD_MARGIN = 6;
83      TX_STOPSTART   = 'The stop date must be after the start date.';
84    
85    procedure TfrmODGen.FormCreate(Sender: TObject);
86    var
87      TheEvtType: string;
88      IDs,TSstr, AttendStr: string;
89    begin
90      FFormCloseCalled := false;   
91      inherited;
92      FilterOut := True;
93      if Self.EvtID < 1 then
94        FilterOut := False;
95      if Self.EvtID > 0 then
96      begin
97        TheEvtType := Piece(EventInfo1(IntToStr(Self.EvtId)), '^', 1);
98        if (TheEvtType = 'A') or (TheEvtType = 'T') or (TheEvtType = 'M') or (TheEvtType = 'O') then
99          FilterOut := False;
100     end;
101     FillerID := 'OR';                     // does 'on Display' order check **KCM**
102     IDs := GetPromptIDs;
103     TSstr := Piece(IDs,'~',1);
104     TsDomain := Piece(TSstr,'^', 1);
105     TsID := Piece(TSstr,'^', 2);
106     AttendStr := Piece(IDs,'~',2);
107     AttendDomain := Piece(AttendStr,'^',1);
108     AttendID := Piece(AttendStr,'^',2);
109     FDialogItemList := TList.Create;
110     FDialogCtrlList := TList.Create;
111   end;
112   
113   procedure TfrmODGen.FormClose(Sender: TObject; var Action: TCloseAction);
114   var
115     i: Integer;
116     DialogCtrl: TDialogCtrl;
117   begin
118     with FDialogItemList do for i := 0 to Count - 1 do TDialogItem(Items[i]).Free;
119     with FDialogCtrlList do for i := 0 to Count - 1 do
120     begin
121       DialogCtrl := TDialogCtrl(Items[i]);
122       with DialogCtrl do
123       begin
124         if Prompt <> nil then Prompt.Free;
125         if Editor <> nil then case DataType of
126         'D': TORDateBox(Editor).Free;
127         'F': TEdit(Editor).Free;
128         'N': TEdit(Editor).Free;
129         'P': TORComboBox(Editor).Free;
130         'R': TORDateBox(Editor).Free;
131         'S': TORComboBox(Editor).Free;
132         'W': TMemo(Editor).Free;
133         'Y': TORComboBox(Editor).Free;
134         else Editor.Free;
135         end;
136         Free;
137       end;
138     end;
139     FDialogItemList.Free;
140     FDialogCtrlList.Free;
141     FFormCloseCalled := true;
142     inherited;
143   end;
144   
145   procedure TfrmODGen.SetDialogIEN(Value: Integer);
146   { Sets up a generic ordering dialog on the fly.  Called before SetupDialog. }
147   var
148     DialogNames: TDialogNames;
149   begin
150     inherited;
151     StatusText('Loading Dialog Definition');
152     IdentifyDialog(DialogNames, DialogIEN);
153     Caption := DialogNames.Display;
154     Responses.Dialog := DialogNames.BaseName;                      // loads formatting info
155     LoadOrderPrompting(FDialogItemList, DialogNames.BaseIEN);      // loads prompting info
156     PlaceControls;
157     StatusText('');
158   end;
159   
160   procedure TfrmODGen.SetupDialog(OrderAction: Integer; const ID: string);
161   var
162     i: Integer;
163     theEvtInfo: string;
164     thePromptIen: integer;
165     AResponse: TResponse;
166     AnEvtResponse: TResponse;
167   begin
168     inherited;
169     if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
170     begin
171       Changing := True;
172       // for copy & edit, SetDialogIEN hasn't been called yet
173       if (Length(ID) > 0) and (DialogIEN = 0) then SetDialogIEN(DialogForOrder(ID));
174       with FDialogCtrlList do for i := 0 to Count -1 do with TDialogCtrl(Items[i]) do
175       begin
176         if (ID = 'EVENT') and ( Responses.EventIFN > 0 ) then
177         begin
178           thePromptIen := GetIENForPrompt(ID);
179           if thePromptIen = 0 then
180             thePromptIen := GetEventPromptID;
181           AResponse := FindResponseByName('EVENT', 1);
182           if AResponse <> nil then
183           begin
184             theEvtInfo := EventInfo1(AResponse.IValue);
185             AResponse.EValue := Piece(theEvtInfo,'^',4);
186           end;
187           if AResponse = nil then
188           begin
189             AnEvtResponse := TResponse.Create;
190             AnEvtResponse.PromptID  := 'EVENT';
191             AnEvtResponse.PromptIEN := thePromptIen;
192             AnEvtResponse.Instance  := 1;
193             AnEvtResponse.IValue    := IntToStr(Responses.EventIFN);
194             theEvtInfo := EventInfo1(AnEvtResponse.IValue);
195             AnEvtResponse.EValue := Piece(theEvtInfo,'^',4);
196             Responses.TheList.Add(AnEvtResponse);
197           end;
198         end;
199         if Editor <> nil then SetControl(Editor, ID, 1);
200         if DataType = 'H' then
201         begin
202           AResponse := FindResponseByName(ID, 1);
203           if AResponse <> nil then
204           begin
205             IHidden := AResponse.IValue;
206             EHidden := AResponse.EValue;
207           end; {if AResponse}
208         end; {if DataType}
209       end; {with TDialogCtrl}
210       Changing := False;
211     end; {if OrderAction}
212     UpdateColorsFor508Compliance(Self);
213     ControlChange(Self);
214     if (FFirstCtrl <> nil) and (FFirstCtrl.Enabled) then SetFocusedControl(FFirstCtrl);
215   end;
216   
217   procedure TfrmODGen.UpdateAccessibilityActions(var Actions: TAccessibilityActions);
218   begin
219     exclude(Actions, aaColorConversion);
220   end;
221   
222   procedure TfrmODGen.InitDialog;
223   var
224     i: Integer;
225   begin
226     inherited; // inherited does a ClearControls (probably never called since always quick order)
227     {NEED TO CLEAR CONTROLS HERE OR CHANGE ClearControls so can clear children of container}
228     with FDialogCtrlList do for i := 0 to Count -1 do
229       with TDialogCtrl(Items[i]) do if (Editor <> nil) and not Preserve then
230       begin
231         // treat the list & combo boxes differently so their lists aren't cleared
232         if      (Editor is TListBox)    then TListBox(Editor).ItemIndex := -1
233         else if (Editor is TComboBox)   then
234         begin
235           TComboBox(Editor).Text := '';
236           TComboBox(Editor).ItemIndex := -1;
237         end
238         else if (Editor is TORComboBox) then
239         begin
240           TORComboBox(Editor).Text := '';
241           TORComboBox(Editor).ItemIndex := -1;
242         end
243         else ClearControl(Editor);
244       end;
245     if FFirstCtrl <> nil then ActiveControl := FFirstCtrl;
246   end;
247   
248   procedure TfrmODGen.VA508CompMemOrderStateQuery(Sender: TObject;
249     var Text: string);
250   begin
251     inherited;
252     Text := memOrder.Text;
253   end;
254   
255   procedure TfrmODGen.Validate(var AnErrMsg: string);
256   var
257     i: Integer;
258     ALabel, AMsg: string;
259     AResponse: TResponse;
260     DialogCtrl: TDialogCtrl;
261     StartDT, StopDT: TFMDateTime;
262   
263     procedure SetError(const x: string);
264     begin
265       if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
266       AnErrMsg := AnErrMsg + x;
267     end;
268   
269   begin
270     inherited;
271     with FDialogCtrlList do for i := 0 to Count -1 do
272     begin
273       DialogCtrl := TDialogCtrl(Items[i]);
274       with DialogCtrl do
275       begin
276         if Prompt <> nil then ALabel := Piece(Prompt.Caption, ':', 1) else ALabel := '<Unknown>';
277         if Required then
278         begin
279           AResponse := Responses.FindResponseByName(ID, 1);
280           if (AResponse = nil) or ((AResponse <> nil) and (AResponse.EValue = ''))
281             then SetError(ALabel + ' is required.');
282         end;
283         if ((DataType = 'D') or (DataType = 'R')) and (Editor <> nil) then
284         begin
285           TORDateBox(Editor).Validate(AMsg);
286           if Length(AMsg) > 0 then SetError('For ' + ALabel + ':  ' + AMsg);
287         end;
288         if (DataType = 'N') then
289         begin
290           AResponse := Responses.FindResponseByName(ID, 1);
291           if (AResponse <> nil) and (Length(AResponse.EValue) > 0) then with AResponse do
292           begin
293             ValidateNumericStr(EValue, Piece(TEdit(Editor).Hint, '|', 2), AMsg);
294             if Length(AMsg) > 0 then SetError('For ' + ALabel + ':  ' + AMsg);
295           end; {if AResponse}
296         end; {if DataType}
297       end; {with DialogCtrl}
298     end; {with FDialogCtrlList}
299     with Responses do
300     begin
301       AResponse := FindResponseByName('START', 1);
302       if AResponse <> nil then StartDT := StrToFMDateTime(AResponse.EValue) else StartDT := 0;
303       AResponse := FindResponseByName('STOP',  1);
304       if AResponse <> nil then StopDT  := StrToFMDateTime(AResponse.EValue) else StopDT  := 0;
305       if (StopDT > 0) and (StopDT <= StartDT) then SetError(TX_STOPSTART);
306     end;
307   end;
308   
309   procedure TfrmODGen.PlaceControls;
310   var
311     i: Integer;
312     DialogItem: TDialogItem;
313     DialogCtrl: TDialogCtrl;
314   begin
315     FCharHt := MainFontHeight;
316     FCharWd := MainFontWidth;
317     FEditorTop := HT_SPACE;
318     FLabelWd := 0;
319     with FDialogItemList do for i := 0 to Count - 1 do with TDialogItem(Items[i]) do
320       if not Hidden then FLabelWd := HigherOf(FLabelWd, Canvas.TextWidth(Prompt));
321     FEditorLeft := FLabelWd + (WD_MARGIN * 2);
322     with FDialogItemList do for i := 0 to Count - 1 do
323     begin
324       DialogItem := TDialogItem(Items[i]);
325       if FilterOut then
326       begin
327         if ( compareText(TsID,DialogItem.Id)=0 ) or ( compareText(TSDomain,DialogItem.Domain)=0) then
328           Continue;
329         if (Pos('primary',LowerCase(DialogItem.Prompt)) > 0) then
330           Continue;
331         if (compareText(AttendID,DialogItem.ID) = 0) or ( compareText(AttendDomain,DialogItem.Domain)=0 ) then
332           Continue;
333       end;
334       DialogCtrl := TDialogCtrl.Create;
335       DialogCtrl.ID       := DialogItem.ID;
336       DialogCtrl.DataType := DialogItem.DataType;
337       DialogCtrl.Required := DialogItem.Required;
338       DialogCtrl.Preserve := Length(DialogItem.EDefault) > 0;
339       case DialogItem.DataType of
340       'D': PlaceDateTime(DialogCtrl, DialogItem, I);
341       'F': PlaceFreeText(DialogCtrl, DialogItem, i);
342       'H': PlaceHidden(DialogCtrl, DialogItem);
343       'N': PlaceNumeric(DialogCtrl, DialogItem, i);
344       'P': PlaceLookup(DialogCtrl, DialogItem, i);
345       'R': PlaceDateTime(DialogCtrl, DialogItem, i);
346       'S': PlaceSetOfCodes(DialogCtrl, DialogItem, i);
347       'W': PlaceMemo(DialogCtrl, DialogItem, i);
348       'Y': PlaceYesNo(DialogCtrl, DialogItem, i);
349       end;
350       FDialogCtrlList.Add(DialogCtrl);
351       if (DialogCtrl.Editor <> nil) and (FFirstCtrl = nil) then FFirstCtrl := DialogCtrl.Editor;
352     end;
353   end;
354   
355   procedure TfrmODGen.PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
356   const
357     NUM_CHAR = 22;
358   begin
359     with DialogCtrl do
360     begin
361       Editor := TORDateBox.Create(Self);
362       Editor.Parent := sbxMain;
363       Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
364       TORDateBox(Editor).DateOnly := Pos('T', DialogItem.Domain) = 0;
365       with TORDateBox(Editor) do RequireTime := (not DateOnly) and (Pos('R', DialogItem.Domain) > 0); //v26.48 - RV  PSI-05-002
366       SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
367     //  TORDateBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
368       TORDateBox(Editor).Text := DialogItem.EDefault;
369       TORDateBox(Editor).Hint := DialogItem.HelpText;
370       TORDateBox(Editor).Caption := DialogItem.Prompt;
371       if Length(DialogItem.HelpText) > 0 then TORDateBox(Editor).ShowHint := True;
372       TORDateBox(Editor).OnExit := ControlChange;
373       PlaceLabel(DialogCtrl, DialogItem);
374       FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
375     end;
376   end;
377   
378   procedure TfrmODGen.PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
379   begin
380     with DialogCtrl do
381     begin
382       Editor := TCaptionEdit.Create(Self);
383       Editor.Parent := sbxMain;
384       Editor.SetBounds(FEditorLeft, FEditorTop,
385                        sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
386                        HT_FRAME * FCharHt);
387       TEdit(Editor).MaxLength := StrToIntDef(Piece(DialogItem.Domain, ':', 2), 0);
388       SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
389     //  TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
390       TEdit(Editor).Text := DialogItem.EDefault;
391       TEdit(Editor).Hint := DialogItem.HelpText;
392       TCaptionEdit(Editor).Caption := DialogItem.Prompt;
393       if Length(DialogItem.HelpText) > 0 then TEdit(Editor).ShowHint := True;
394       TEdit(Editor).OnChange := ControlChange;
395       PlaceLabel(DialogCtrl, DialogItem);
396       FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
397     end;
398   end;
399   
400   procedure TfrmODGen.PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
401   const
402     NUM_CHAR = 16;
403   begin
404     with DialogCtrl do
405     begin
406       Editor := TCaptionEdit.Create(Self);
407       Editor.Parent := sbxMain;
408       Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
409       TEdit(Editor).MaxLength := NUM_CHAR;
410       SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
411      // TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
412       TEdit(Editor).Text := DialogItem.EDefault;
413       TEdit(Editor).Hint := DialogItem.HelpText + '|' + DialogItem.Domain;
414       TCaptionEdit(Editor).Caption := DialogItem.Prompt;
415       if Length(DialogItem.HelpText) > 0 then TEdit(Editor).ShowHint := True;
416       TEdit(Editor).OnChange := ControlChange;
417       PlaceLabel(DialogCtrl, DialogItem);
418       FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
419     end;
420   end;
421   
422   procedure TfrmODGen.PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
423   const
424     NUM_CHAR = 32;
425   var
426     x, y: string;
427   begin
428     with DialogCtrl do
429     begin
430       Editor := TORComboBox.Create(Self);
431       Editor.Parent := sbxMain;
432       TORComboBox(Editor).Style := orcsDropDown;
433       TORComboBox(Editor).ListItemsOnly := True;
434       TORComboBox(Editor).Pieces := '2';
435       SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
436     //  TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
437       Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
438       x := DialogItem.Domain;
439       repeat
440         y := Piece(x, ';', 1);
441         Delete(x, 1, Length(y) + 1);
442         y := Piece(y, ':', 1) + U + Piece(y, ':', 2);
443         TORComboBox(Editor).Items.Add(y);
444       until Length(x) = 0;
445       TORComboBox(Editor).SelectByID(DialogItem.IDefault);
446       //TORComboBox(Editor).Text := DialogItem.EDefault;
447       TORComboBox(Editor).RpcCall := DialogItem.HelpText;
448       if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
449       TORComboBox(Editor).OnChange := ControlChange;
450       PlaceLabel(DialogCtrl, DialogItem);
451       FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
452     end;
453   end;
454   
455   procedure TfrmODGen.PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
456   const
457     NUM_CHAR = 9;
458   begin
459     with DialogCtrl do
460     begin
461       Editor := TORComboBox.Create(Self);
462       Editor.Parent := sbxMain;
463       TORComboBox(Editor).Style := orcsDropDown;
464       TORComboBox(Editor).ListItemsOnly := True;
465       TORComboBox(Editor).Pieces := '2';
466       SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
467       //TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
468       Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
469       TORComboBox(Editor).Items.Add('0^No');
470       TORComboBox(Editor).Items.Add('1^Yes');
471       TORComboBox(Editor).SelectByID(DialogItem.IDefault);
472       //TORComboBox(Editor).Text := DialogItem.EDefault;
473       TORComboBox(Editor).RpcCall := DialogItem.HelpText;
474       if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
475       TORComboBox(Editor).OnChange := ControlChange;
476       PlaceLabel(DialogCtrl, DialogItem);
477       FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
478     end;
479   end;
480   
481   procedure TfrmODGen.PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
482   const
483     NUM_CHAR = 32;
484   var
485     idx,defidx,evtChars: integer;
486     GblRef, XRef: string;
487     TopTSList: TStringList;
488   begin
489     with DialogCtrl do
490     begin
491       GblRef := DialogItem.Domain;
492       if CharAt(GblRef, 1) in ['0'..'9','.']
493         then GblRef := GlobalRefForFile(Piece(GblRef, ':', 1))
494         else GblRef := Piece(GblRef, ':', 1);
495       if CharAt(GblRef, 1) <> U then GblRef := U + GblRef;
496       if Length(DialogItem.CrossRef) > 0 then XRef := DialogItem.CrossRef else XRef := 'B';
497       XRef := GblRef + '"' + XRef + '")';
498       Editor := TORComboBox.Create(Self);
499       Editor.Parent := sbxMain;
500       TORComboBox(Editor).Style := orcsDropDown;
501       TORComboBox(Editor).ListItemsOnly := True;
502       TORComboBox(Editor).Pieces := '2';
503       TORComboBox(Editor).LongList := True;
504        SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
505      // TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
506       // 2nd bar piece of hint is not visible, hide xref, global ref, & screen code in tab pieces
507       TORComboBox(Editor).RpcCall := DialogItem.HelpText + '|' + XRef + #9 + GblRef + #9 +
508                                   DialogItem.ScreenRef;
509       if ( compareText(TsID,DialogItem.Id)=0 ) or (compareText(TSDomain,DialogItem.Domain)=0)then
510       begin
511         TopTSList := TStringList.Create;
512         DialogItem.IDefault := Piece(GetDefaultTSForEvt(Self.EvtID),'^',1);
513         GetTSListForEvt(TStrings(TopTSList),Self.EvtID);
514         if TopTSList.Count > 0 then
515         begin
516           if Length(DialogItem.IDefault)>0 then
517           begin
518             defidx := -1;
519             for idx := 0 to topTSList.Count - 1 do
520               if Piece(TopTSList[idx],'^',1)= DialogItem.IDefault then
521               begin
522                 defidx := idx;
523                 break;
524               end;
525             if defidx >= 0 then
526               topTSList.Move(defidx,0);
527           end;
528           with TORComboBox(Editor) do
529           begin
530             FastAddStrings(TStrings(TopTSList), TORComboBox(Editor).Items);
531             LongList := false;
532           end;
533         end else
534           TORComboBox(Editor).OnNeedData := LookupNeedData;
535         if Length(DialogItem.IDefault)<1 then
536           DialogItem.IDefault := '0';
537       end else
538         TORComboBox(Editor).OnNeedData := LookupNeedData;
539       Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
540       TORComboBox(Editor).InitLongList(DialogItem.EDefault);
541       TORComboBox(Editor).SelectByID(DialogItem.IDefault);
542       if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
543       TORComboBox(Editor).OnChange := ControlChange;
544       if ( AnsiCompareText(ID,'EVENT')=0 ) and (Self.EvtID>0)then
545       begin
546          evtChars := length(Responses.EventName);
547          if evtChars > NUM_CHAR then
548             Editor.SetBounds(FEditorLeft, FEditorTop, (evtChars + 6) * FCharWd, HT_FRAME * FCharHt);
549          TORComboBox(Editor).Enabled := False;
550       end;
551       PlaceLabel(DialogCtrl, DialogItem);
552       FEditorTop := FEditorTop + HT_FRAME + FCharHt + HT_SPACE;
553     end;
554   end;
555   
556   procedure TfrmODGen.LookupNeedData(Sender: TObject; const StartFrom: string;
557     Direction, InsertAt: Integer);
558   var
559     XRef, GblRef, ScreenRef: string;
560   begin
561     inherited;
562     XRef := Piece(TORComboBox(Sender).RpcCall, '|', 2);
563     GblRef    := Piece(XRef, #9, 2);
564     ScreenRef := Piece(XRef, #9, 3);
565     XRef      := Piece(XRef, #9, 1);
566     TORComboBox(Sender).ForDataUse(SubsetOfEntries(StartFrom, Direction, XRef, GblRef, ScreenRef));
567   end;
568   
569   procedure TfrmODGen.PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
570   const
571     NUM_LINES = 3;
572   begin
573     with DialogCtrl do
574     begin
575       Editor := TCaptionMemo.Create(Self);
576       Editor.Parent := sbxMain;
577       Editor.SetBounds(FEditorLeft, FEditorTop,
578                        sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
579                        (FCharHt * NUM_LINES) + HT_FRAME);
580       SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
581      // TCaptionMemo(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
582       TMemo(Editor).Text := DialogItem.EDefault;
583       TMemo(Editor).Hint := DialogItem.HelpText;
584       TCaptionMemo(Editor).Caption := DialogItem.Prompt;
585       if Length(DialogItem.HelpText) > 0 then TMemo(Editor).ShowHint := True;
586       TMemo(Editor).ScrollBars := ssVertical;
587       TMemo(Editor).OnChange := ControlChange;
588       PlaceLabel(DialogCtrl, DialogItem);
589       FEditorTop := FEditorTop + HT_FRAME + (FCharHt * 3) + HT_SPACE;
590     end;
591   end;
592   
593   procedure TfrmODGen.PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
594   begin
595     DialogCtrl.IHidden := DialogItem.IDefault;
596     DialogCtrl.EHidden := DialogItem.EDefault;
597   end;
598   
599   procedure TfrmODGen.PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
600   var
601     ht: integer;
602   begin
603     with DialogCtrl do
604     begin
605       Prompt := TStaticText.Create(Self);
606       Prompt.Parent := sbxMain;
607       Prompt.Caption := DialogItem.Prompt;
608       ht := Prompt.Height;   // CQ#15849
609       if ht < FCharHt then
610         ht := FCharHt;
611       Prompt.AutoSize := False;
612       Prompt.SetBounds(WD_MARGIN, FEditorTop + HT_LBLOFF, FLabelWd, ht);
613       Prompt.Alignment := taRightJustify;
614       Prompt.Visible := True;
615     end;
616   end;
617   
618   procedure TfrmODGen.TrimAllMemos;
619   var
620     i : integer;
621     Memo : TMemo;
622   begin
623     if FFormCloseCalled then Exit; //it is possible for TrimAllMemos to get called after FormClose
624     if Not Assigned(FDialogCtrlList) then Exit;
625     for i := 0 to FDialogCtrlList.Count - 1 do
626       if TDialogCtrl(FDialogCtrlList.Items[i]).Editor is TMemo then begin
627         Memo := TMemo(TDialogCtrl(FDialogCtrlList.Items[i]).Editor);
628         Memo.Lines.Text := Trim(Memo.Lines.Text);
629       end;
630   end;
631   
632   procedure TfrmODGen.cmdAcceptClick(Sender: TObject);
633   begin
634     inherited;
635     TrimAllMemos;
636     Application.ProcessMessages;
637   end;
638   
639   procedure TfrmODGen.ControlChange(Sender: TObject);
640   var
641     i: Integer;
642   begin
643     inherited;
644     if Changing then Exit;
645     with FDialogCtrlList do for i := 0 to Count - 1 do with TDialogCtrl(Items[i]) do
646     begin
647       case DataType of
648       'D': Responses.Update(ID, 1, FloatToStr(TORDateBox(Editor).FMDateTime),
649                                    TORDateBox(Editor).Text);
650       'F': Responses.Update(ID, 1, TEdit(Editor).Text, TEdit(Editor).Text);
651       'H': Responses.Update(ID, 1, IHidden, EHidden);
652       'N': Responses.Update(ID, 1, TEdit(Editor).Text, TEdit(Editor).Text);
653       'P': Responses.Update(ID, 1, TORComboBox(Editor).ItemID, TORComboBox(Editor).Text);
654       'R': Responses.Update(ID, 1, TORDateBox(Editor).Text, TORDateBox(Editor).Text);
655       'S': Responses.Update(ID, 1, TORComboBox(Editor).ItemID, TORComboBox(Editor).Text);
656       'W': Responses.Update(ID, 1, TX_WPTYPE, TMemo(Editor).Text);
657       'Y': Responses.Update(ID, 1, TORComboBox(Editor).ItemID, TORComboBox(Editor).Text);
658       end;
659     end;
660     memOrder.Text := Responses.OrderText;
661   end;
662   
663   procedure TfrmODGen.SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl);
664   Var
665    I: Integer;
666    SaveName: String;
667   begin
668    //strip all non alphanumeric characters to create the save name
669    SaveName := '';
670    //Check for blank id
671    if DialogCtrl.ID = '' then DialogCtrl.ID := 'EMPTY';
672   
673    for i := 1 to length(DialogCtrl.ID) do begin
674      if (DialogCtrl.ID[i] in ['A'..'Z']) or (DialogCtrl.ID[i] in ['a'..'z']) or (DialogCtrl.ID[i] in ['0'..'9']) then
675       SaveName := SaveName + DialogCtrl.ID[i];
676    end;
677    SaveName := SaveName + '_' + IntToStr(Index);
678   
679    //extra backup - make sure that the component name doesn't already exist
680    //Now set up the component name
681    try
682     Editor.Name := SaveName;
683    except
684     Editor.Name := SaveName + '_' + IntToStr(Index);
685    end;
686   end;
687   
688   end.

Module Calls (2 levels)


fODGen
 ├fODBase
 │ ├fAutoSz
 │ ├uConst
 │ ├rOrders
 │ ├rODBase
 │ ├uCore
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 ├rODBase...
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rCore...
 ├rOrders...
 └uConst

Module Called-By (2 levels)


                      fODGen
                   uOrders┘ 
                   uCore┤   
                 fODBase┤   
                 rODBase┤   
                  fFrame┤   
                 fOrders┤   
             fOrdersSign┤   
                   fMeds┤   
               fARTAllgy┤   
                  fNotes┤   
               fConsults┤   
         fReminderDialog┤   
                 fReview┤   
            fOrdersRenew┤   
               fOrdersCV┤   
                 fODMeds┤   
                 fOMNavA┤   
         fOrderSaveQuick┤   
                  fOMSet┤   
          fOrdersRelease┤   
                 fOMHTML┤   
               fODMedNVA┤   
fODChangeUnreleasedRenew┤   
          fOrdersOnChart┤   
         fODReleaseEvent┤   
               fODActive┘