Module

fOtherSchedule

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
rMisc -
rODMeds -

Units Used in Implementation

Name Comments
rOrders -

Classes

Name Comments
TfrmOtherSchedule -

Procedures

Name Owner Declaration Scope Comments
btn0k1Click TfrmOtherSchedule procedure btn0k1Click(Sender: TObject); Public/Published -
btnAddClick TfrmOtherSchedule procedure btnAddClick(Sender: TObject); Public/Published -
btnCancelClick TfrmOtherSchedule procedure btnCancelClick(Sender: TObject); Public/Published -
btnRemoveClick TfrmOtherSchedule procedure btnRemoveClick(Sender: TObject); Public/Published -
btnResetClick TfrmOtherSchedule procedure btnResetClick(Sender: TObject); Public/Published -
btnSchAddClick TfrmOtherSchedule procedure btnSchAddClick(Sender: TObject); Public/Published -
btnSchRemoveClick TfrmOtherSchedule procedure btnSchRemoveClick(Sender: TObject); Public/Published -
Button1Click TfrmOtherSchedule procedure Button1Click(Sender: TObject); Public/Published -
cbo1Click TfrmOtherSchedule procedure cbo1Click(Sender: TObject); Public/Published -
cbo2Click TfrmOtherSchedule procedure cbo2Click(Sender: TObject); Public/Published -
cbo3Click TfrmOtherSchedule procedure cbo3Click(Sender: TObject); Public/Published -
cbo4Click TfrmOtherSchedule procedure cbo4Click(Sender: TObject); Public/Published -
cbo5Click TfrmOtherSchedule procedure cbo5Click(Sender: TObject); Public/Published -
cbo6Click TfrmOtherSchedule procedure cbo6Click(Sender: TObject); Public/Published -
cbo7Click TfrmOtherSchedule procedure cbo7Click(Sender: TObject); Public/Published -
EnabledSch TfrmOtherSchedule procedure EnabledSch(TF: boolean); Private -
EnabledTime TfrmOtherSchedule procedure EnabledTime(TF: boolean); Private -
FormClose TfrmOtherSchedule procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmOtherSchedule procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmOtherSchedule procedure FormDestroy(Sender: TObject); Public/Published -
lstHourClick TfrmOtherSchedule procedure lstHourClick(Sender: TObject); Public/Published -
lstMinuteKeyDown TfrmOtherSchedule procedure lstMinuteKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
lstMinuteMouseUp TfrmOtherSchedule procedure lstMinuteMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
NSScboScheduleExit TfrmOtherSchedule procedure NSScboScheduleExit(Sender: TObject); Public/Published -
NSScboScheduleKeyUp TfrmOtherSchedule procedure NSScboScheduleKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
SetDaySchedule TfrmOtherSchedule procedure SetDaySchedule(Sender: TObject); Private -
SetScheduleSelection TfrmOtherSchedule procedure SetScheduleSelection; Private -
SetTimeSchedule TfrmOtherSchedule procedure SetTimeSchedule; Private -
txtScheduleChange TfrmOtherSchedule procedure txtScheduleChange(Sender: TObject); Public/Published -
updateCheckbox - procedure updateCheckbox(aDList: TStringList); Local -
UpdateOnFreeTextInput TfrmOtherSchedule procedure UpdateOnFreeTextInput; Private -

Functions

Name Owner Declaration Scope Comments
CheckDay TfrmOtherSchedule function CheckDay(ADayStr: string): string; Private -
GetSiteMessage TfrmOtherSchedule function GetSiteMessage: string; Private -
ShowOtherSchedule - function ShowOtherSchedule(var ASchedule: string): boolean; Interfaced -

Global Variables

Name Type Declaration Comments
frmOtherSchedule TfrmOtherSchedule frmOtherSchedule: TfrmOtherSchedule; -

Constants

Name Declaration Scope Comments
NSS_TXT 'This order will not become active until a valid schedule is used.' Interfaced -


Module Source

1     unit fOtherSchedule;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7       Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, fAutoSz, rMisc, ORCtrls, rODMeds,
8       VA508AccessibilityManager, VAUtils;
9     
10    const
11      NSS_TXT = 'This order will not become active until a valid schedule is used.';
12    
13    type
14      TfrmOtherSchedule = class(TfrmAutoSz)
15        Panel1: TPanel;
16        Image1: TImage;
17        Panel3: TPanel;
18        GroupBox1: TGroupBox;
19        cbo7: TCheckBox;
20        cbo1: TCheckBox;
21        cbo2: TCheckBox;
22        cbo3: TCheckBox;
23        cbo4: TCheckBox;
24        cbo5: TCheckBox;
25        cbo6: TCheckBox;
26        GroupBox2: TGroupBox;
27        lstHour: TListBox;
28        lstMinute: TListBox;
29        Panel4: TPanel;
30        btn0k1: TButton;
31        btnCancel: TButton;
32        Label1: TLabel;
33        btnReset: TButton;
34        btnRemove: TButton;
35        memMessage: TMemo;
36        Splitter1: TSplitter;
37        btnAdd: TButton;
38        Button1: TButton;
39        GroupBox3: TGroupBox;
40        NSScboSchedule: TORComboBox;
41        btnSchAdd: TButton;
42        btnSchRemove: TButton;
43        txtSchedule: TEdit;
44        procedure FormCreate(Sender: TObject);
45        procedure btnCancelClick(Sender: TObject);
46        procedure btn0k1Click(Sender: TObject);
47        procedure cbo7Click(Sender: TObject);
48        procedure cbo1Click(Sender: TObject);
49        procedure cbo2Click(Sender: TObject);
50        procedure cbo3Click(Sender: TObject);
51        procedure cbo4Click(Sender: TObject);
52        procedure cbo5Click(Sender: TObject);
53        procedure cbo6Click(Sender: TObject);
54        procedure btnAddClick(Sender: TObject);
55        procedure btnResetClick(Sender: TObject);
56        procedure btnRemoveClick(Sender: TObject);
57        procedure FormClose(Sender: TObject; var Action: TCloseAction);
58        procedure lstHourClick(Sender: TObject);
59        procedure txtScheduleChange(Sender: TObject);
60        procedure lstMinuteMouseUp(Sender: TObject; Button: TMouseButton;
61          Shift: TShiftState; X, Y: Integer);
62        procedure lstMinuteKeyDown(Sender: TObject; var Key: Word;
63          Shift: TShiftState);
64        procedure Button1Click(Sender: TObject);
65        procedure btnSchAddClick(Sender: TObject);
66        procedure btnSchRemoveClick(Sender: TObject);
67        procedure FormDestroy(Sender: TObject);
68        procedure NSScboScheduleExit(Sender: TObject);
69        procedure NSScboScheduleKeyUp(Sender: TObject; var Key: Word;
70          Shift: TShiftState);
71      private
72        FDaySchedule: array [1..7] of string;
73        FTimeSchedule: TStringList;
74        FSchedule: String;
75        FOtherSchedule: String;
76        FFromCheckBox: boolean;
77        FFromEditBox: boolean;
78        function GetSiteMessage: string;
79        procedure SetDaySchedule(Sender: TObject);
80        procedure SetTimeSchedule;
81        procedure SetScheduleSelection;
82        procedure UpdateOnFreeTextInput;
83        procedure EnabledTime(TF: boolean);
84        procedure EnabledSch(TF: boolean);
85        function CheckDay(ADayStr: string): string;
86        
87      public
88      end;
89    
90    function ShowOtherSchedule(var ASchedule: string): boolean;
91    
92    var
93       frmOtherSchedule: TfrmOtherSchedule;
94    
95    implementation
96    
97    uses ORFn, ORNet, rOrders;
98    {$R *.dfm}
99    
100   function ShowOtherSchedule(var ASchedule: string):
101   
102   boolean;
103   var
104   
105     AdminTime, SchType: string;
106   begin
107     Result := False;
108     try
109      ASchedule := '';
110      frmOtherSchedule := TfrmOtherSchedule.Create(Application);
111      ResizeFormToFont(TForm(frmOtherSchedule));
112      SetFormPosition(frmOtherSchedule);
113      if frmOtherSchedule.ShowModal = mrOK then
114      begin
115        ASchedule := UpperCase(frmOtherSchedule.FOtherSchedule);
116        if frmOtherSchedule.GroupBox3.Enabled = True then
117          begin
118            AdminTime := Piece(frmOtherSchedule.NSScboSchedule.Items.Strings[frmOtherSchedule.NSScboSchedule.itemindex],U,4);
119            schType := Piece(frmOtherSchedule.NSScboSchedule.Items.Strings[frmOtherSchedule.NSScboSchedule.itemindex],U,3);
120            ASchedule := ASchedule + U + AdminTime + U + schType;
121            //if (schType = 'P') or (schType = 'OC') then ASchedule := ASchedule + U + '1'
122            //else ASchedule := ASchedule + U + '0';
123          end
124        else if frmOtherSchedule.GroupBox2.Enabled = true then
125          begin
126            AdminTime := Piece(ASchedule,'@',2);
127            ASchedule := ASchedule + U + AdminTime + U + 'C';
128          end;
129        Result := True;
130      end;
131     except
132      ShowMsg('Error happen when building other schedule');
133     end;
134   end;
135   
136   
137   procedure TfrmOtherSchedule.FormCreate(Sender: TObject);
138   var
139     i: integer;
140     nssMsg: string;
141   begin
142     frmOtherSchedule := nil;
143     FFromCheckBox := False;
144     FFromEditBox := False;
145     image1.Picture.Icon.Handle := LoadIcon(0, IDI_WARNING);
146     for i := 1 to 7 do
147      FDaySchedule[i] := '';
148     FTimeSchedule := TStringlist.Create;
149     FSchedule := '';
150     FOtherSchedule := '';
151     nssMsg := GetSiteMessage;
152     if Length(nssMsg)< 1 then
153       nssMsg := NSS_TXT;
154     memMessage.Lines.Add(nssMsg);
155     LoadDOWSchedules(NSScboSchedule.Items);
156     if ScreenReaderActive = false then txtSchedule.TabStop := false;
157   
158   end;
159   
160   procedure TfrmOtherSchedule.FormDestroy(Sender: TObject);
161   begin
162     inherited;
163       //FDaySchedule
164       FTimeSchedule.Free;
165       frmOtherSchedule := nil;
166       //FSchedule: String;
167       //FOtherSchedule: String;
168   end;
169   
170   procedure TfrmOtherSchedule.btnCancelClick(Sender: TObject);
171   begin
172     frmOtherSchedule.Release;
173   end;
174   
175   procedure TfrmOtherSchedule.btn0k1Click(Sender: TObject);
176   begin
177     if (cbo1.Checked = false) and (cbo2.Checked = false) and (cbo3.Checked = false) and (cbo4.Checked = false) and (cbo5.Checked = false) and
178       (cbo6.Checked = false) and (cbo7.Checked = false) then
179       begin
180         ShowMsg('A day of week must be selected!');
181         Exit;
182       end;
183     if Pos('@', self.txtSchedule.Text) = 0 then
184       begin
185         ShowMsg('An Administation Time or a schedule needs to be selected');
186         exit;
187       end;
188   (*  if not IsValidSchStr(FOtherSchedule) then
189     begin
190       Show508Message('The schedule you entered is invalid!');
191       Exit;
192     end;  *)
193     modalResult := mrOK;
194   end;
195   
196   procedure TfrmOtherSchedule.SetDaySchedule(Sender: TObject);
197   var
198     i : integer;
199     TimePart, DayPart, Schedule: string;
200   begin
201     with (Sender as TCheckBox) do
202     begin
203       try
204         if TCheckBox(Sender).Checked then
205           FDaySchedule[TCheckBox(Sender).Tag] := Copy(TCheckBox(Sender).Caption,0,2)
206         else
207           FDaySchedule[TCheckBox(Sender).Tag] := '';
208       except
209         ShowMsg('Error happened when building day schedule.');
210         Exit;
211       end;
212     end;
213   
214     TimePart := '';
215     DayPart := '';
216     schedule := '';
217     if Self.GroupBox2.Enabled = True then
218       begin
219           for i := 0 to FTimeSchedule.Count - 1 do
220             begin
221               if i = 0 then TimePart := TimePart + FTimeSchedule[i]
222               else TimePart := TimePart + '-' + FTimeSchedule[i];
223             end;
224       end;
225     if (self.GroupBox3.Enabled = True) and (FSchedule <> '') then schedule := FSchedule;
226     for i := Low(FDaySchedule) to High(FDaySchedule) do
227     begin
228       if Length(FDaySchedule[i])>0 then
229       begin
230         if DayPart = '' then DayPart := FDaySchedule[i]
231         else DayPart := DayPart + '-' + FDaySchedule[i];
232       end;
233     end;
234     if Length(TimePart) > 0 then
235     begin
236       if Length(DayPart) > 0 then
237         FOtherSchedule := DayPart + '@' + TimePart
238       else if Length(DayPart) = 0 then
239         FOtherSchedule := TimePart;
240     end
241     else if Length(schedule) > 0 then
242       begin
243         if length(DayPart) > 0 then
244         FOtherSchedule := DayPart + '@' + Schedule
245       else if Length(DayPart) = 0 then
246         FOtherSchedule := Schedule;
247       end
248     else FOtherSchedule := DayPart;
249     txtSchedule.Text := FOtherSchedule;
250   end;
251   
252   
253   procedure TfrmOtherSchedule.SetScheduleSelection;
254   var
255     i: integer;
256     DayPart: string;
257   begin
258     DayPart := '';
259     for i := Low(FDaySchedule) to High(FDaySchedule) do
260     begin
261       if Length(FDaySchedule[i])>0 then
262       begin
263         if DayPart = '' then DayPart := FDaySchedule[i]
264         else DayPart := DayPart + '-' + FDaySchedule[i];
265       end;
266     end;
267     if Length(DayPart) > 0 then
268     begin
269       if FSchedule <> '' then
270         FOtherSchedule := DayPart + '@' + FSchedule
271       else
272         FOtherSchedule := DayPart;
273     end
274     else FOtherSchedule := FSchedule;
275     //if Length(APRN) > 0 then FOtherSchedule := FOtherSchedule;
276     txtSchedule.Text := FOtherSchedule;
277   end;
278   
279   procedure TfrmOtherSchedule.SetTimeSchedule;
280   var
281     i : integer;
282     TimePart, DayPart,APRN,ASearchTxt: string;
283   begin
284     TimePart := '';
285     DayPart := '';
286     APRN := '';
287     ASearchTxt := UpperCase(txtSchedule.Text);
288     if StrPos(PChar(ASearchTxt),PChar('PRN')) <> nil then APRN := ' PRN'; //hds8326 retain PRN free text if data time entered
289     for i := 0 to FTimeSchedule.Count - 1 do
290     begin
291       if i = 0 then TimePart := TimePart + FTimeSchedule[i]
292       else TimePart := TimePart + '-' + FTimeSchedule[i];
293     end;
294     for i := Low(FDaySchedule) to High(FDaySchedule) do
295     begin
296       if Length(FDaySchedule[i])>0 then
297       begin
298         if DayPart = '' then DayPart := FDaySchedule[i]
299         else DayPart := DayPart + '-' + FDaySchedule[i];
300       end;
301     end;
302     if Length(DayPart) > 0 then
303     begin
304       if Length(TimePart) > 0 then
305         FOtherSchedule := DayPart + '@' + TimePart
306       else
307         FOtherSchedule := DayPart;
308     end
309     else FOtherSchedule := TimePart;
310     if Length(APRN) > 0 then FOtherSchedule := FOtherSchedule + APRN; //hds8326 retain PRN free text if data time entered
311     txtSchedule.Text := FOtherSchedule;
312   end;
313   
314   procedure TfrmOtherSchedule.cbo7Click(Sender: TObject);
315   begin
316     FFromCheckBox := True;
317     if not FFromEditBox then
318       SetDaySchedule(Sender);
319     FFromCheckBox := False;
320   end;
321   
322   procedure TfrmOtherSchedule.cbo1Click(Sender: TObject);
323   begin
324     FFromCheckBox := True;
325     if not FFromEditBox then
326       SetDaySchedule(Sender);
327     FFromCheckBox := False;
328   end;
329   
330   procedure TfrmOtherSchedule.cbo2Click(Sender: TObject);
331   begin
332     FFromCheckBox := True;
333     if not FFromEditBox then
334       SetDaySchedule(Sender);
335     FFromCheckBox := False;
336   end;
337   
338   procedure TfrmOtherSchedule.cbo3Click(Sender: TObject);
339   begin
340     FFromCheckBox := True;
341     if not FFromEditBox then
342       SetDaySchedule(Sender);
343     FFromCheckBox := False;
344   end;
345   
346   procedure TfrmOtherSchedule.cbo4Click(Sender: TObject);
347   begin
348     FFromCheckBox := True;
349     if not FFromEditBox then
350       SetDaySchedule(Sender);
351     FFromCheckBox := False;
352   end;
353   
354   procedure TfrmOtherSchedule.cbo5Click(Sender: TObject);
355   begin
356     FFromCheckBox := True;
357     if not FFromEditBox then
358       SetDaySchedule(Sender);
359     FFromCheckBox := False;
360   end;
361   
362   procedure TfrmOtherSchedule.cbo6Click(Sender: TObject);
363   begin
364     FFromCheckBox := True;
365     if not FFromEditBox then
366       SetDaySchedule(Sender);
367     FFromCheckBox := False;
368   end;
369   
370   procedure TfrmOtherSchedule.btnAddClick(Sender: TObject);
371   var
372     hour, min: string;
373   begin
374     if FSchedule <> '' then Exit;
375     if lstHour.ItemIndex < 0 then exit;
376     hour := lstHour.Items[lstHour.ItemIndex];
377     hour := Trim(Copy(hour,1,3));
378     if length(Trim(hour)) = 1 then
379       hour := '0' + Trim(hour);
380     if lstMinute.ItemIndex >= 0 then
381     begin
382       min := lstMinute.Items[lstMinute.itemIndex];
383       min := Copy(min,2,2);
384     end;
385     if min = '' then min := '00';
386     if (hour='00') and (min='00') then hour := '24';
387     if FTimeSchedule.IndexOf(hour)>=0 then
388     begin
389       FTimeSchedule[FTimeSchedule.IndexOf(hour)] := hour + min;
390     end;
391     if FTimeSchedule.IndexOf(hour+min) < 0 then
392       FTimeSchedule.Add(hour+min);
393     FTimeSchedule.Sort;
394     SetTimeSchedule;
395     if FTimeSchedule.Count > 0 then EnabledSch(False);
396   end;
397   
398   procedure TfrmOtherSchedule.btnResetClick(Sender: TObject);
399   var
400     i : integer;
401   begin
402     cbo1.Checked := false;
403     cbo2.Checked := false;
404     cbo3.Checked:= false;
405     cbo4.Checked := false;
406     cbo5.Checked := false;
407     cbo6.Checked := false;
408     cbo7.Checked := false;
409     lstHour.ItemIndex := -1;
410     lstMinute.ItemIndex := -1;
411     NSScboSchedule.ItemIndex := -1;
412     for i := low(FDaySchedule) to high(FDaySchedule) do
413       FDaySchedule[i] := '';
414     FTimeSchedule.Clear;
415     FOtherSchedule := '';
416     txtSchedule.Text := '';
417     FSchedule := '';
418     EnabledTime(True);
419     EnabledSch(True);
420   end;
421   
422   procedure TfrmOtherSchedule.btnSchAddClick(Sender: TObject);
423   begin
424     inherited;
425     if self.NSScboSchedule.ItemIndex < 0 then Exit;
426     if FSchedule <> '' then
427       begin
428         infoBox('A Day-of-week schedule can only contain one schedule','Warning',MB_OK);
429         Exit;
430       end;
431     FSchedule := self.NSScboSchedule.Text;
432     SetScheduleSelection;
433     Self.NSScboSchedule.Enabled := False;
434     EnabledTime(False);
435   end;
436   
437   procedure TfrmOtherSchedule.btnSchRemoveClick(Sender: TObject);
438   begin
439     inherited;
440     if (FSchedule = '') or (self.NSScboSchedule.ItemIndex < 0) then exit;
441     if self.NSScboSchedule.Text <> FSchedule then exit;
442     Fschedule := '';
443     SetScheduleSelection;
444     self.NSScboSchedule.Enabled := True;
445     EnabledTime(True);
446   end;
447   
448   procedure TfrmOtherSchedule.btnRemoveClick(Sender: TObject);
449   var
450     hour, min: string;
451     idx : integer;
452   begin
453     FFromCheckBox := True;
454     if lstHour.ItemIndex >= 0 then
455     begin
456       hour := lstHour.Items[lstHour.ItemIndex];
457       hour := Trim(Copy(hour,1,3));
458       if length(hour) = 1 then
459         hour := '0' + Trim(hour);
460     end;
461     if lstMinute.ItemIndex >= 0 then
462     begin
463       min := lstMinute.Items[lstMinute.itemIndex];
464       min := Copy(min,2,2);
465     end;
466     if min = '' then min := '00';
467     if (hour='00') and (min='00') then hour := '24';
468     idx := FTimeSchedule.IndexOf(hour+min);
469     if idx > -1 then
470       FTimeSchedule.Delete(idx);
471     FTimeSchedule.Sort;
472     SetTimeSchedule;
473     FFromCheckBox := False;
474     if FTimeSchedule.Count = 0 then EnabledSch(True);
475   end;
476   
477   function TfrmOtherSchedule.GetSiteMessage: string;
478   var
479     i: integer;
480     rstStr: string;
481   begin
482     rstStr := '';
483     CallV('ORWNSS NSSMSG',[nil]);
484     for i := 0 to RPCBrokerV.Results.Count - 1 do
485       rstStr := rstStr + RPCBrokerV.Results[i];
486     Result := rstStr;
487   end;
488   
489   procedure TfrmOtherSchedule.FormClose(Sender: TObject;
490     var Action: TCloseAction);
491   begin
492     try
493       inherited;
494       SaveUserBounds(Self);
495       Action := caFree;
496     except
497       Action := caFree;
498     end;
499     //frmOtherSchedule := nil;
500   end;
501   
502   procedure TfrmOtherSchedule.UpdateOnFreeTextInput;
503   var
504     dayStr,timeStr: string;
505     dayList: TStringList;
506     i,Code,cnt : integer;
507     OrigSch: string;
508   
509     procedure updateCheckbox(aDList: TStringList);
510     var
511       idx: integer;
512       x: string;
513     begin
514       for idx := aDList.Count - 1 downto 0 do
515       begin
516       // cq hds8326 PRN entered manually split PRN from DOW to retain last DOW
517         x := UpperCase(aDList.Strings[idx]); // added to properly process DOW when followed by a space "PRN".
518         if Piece(x,' ',2) = 'PRN' then
519            aDLIst.Strings[idx] := Piece(x,' ',1);
520       // cq hds8326
521         if ((CheckDay(aDList[idx]) = 'SUN') or (CheckDay(aDList[idx]) = 'SU')) then
522           begin
523             cbo7.Checked := true;
524             aDList[idx] := 'SU';
525             FDaySchedule[cbo7.tag] := 'SU';
526           end
527         else if ((CheckDay(aDList[idx]) = 'MON') or (CheckDay(aDList[idx]) = 'MO')) then
528           begin
529             cbo1.Checked := true;
530             aDList[idx] := 'MO';
531             FDaySchedule[cbo1.tag] := 'MO';
532           end
533         else if ((CheckDay(aDList[idx]) = 'TUE') or (CheckDay(aDList[idx]) = 'TU')) then
534           begin
535             cbo2.Checked := true;
536             aDList[idx] := 'TU';
537             FDaySchedule[cbo2.tag] := 'TU';
538           end
539         else if ((CheckDay(aDList[idx]) = 'WED') or (CheckDay(aDList[idx]) = 'WE')) then
540           begin
541             cbo3.Checked := true;
542             aDList[idx] := 'WE';
543             FDaySchedule[cbo3.tag] := 'WE';
544           end
545         else if ((CheckDay(aDList[idx]) = 'THU') or (CheckDay(aDList[idx]) = 'TH')) then
546           begin
547             cbo4.Checked := true;
548             aDList[idx] := 'TH';
549             FDaySchedule[cbo4.tag] := 'TH';
550           end
551         else if ((CheckDay(aDList[idx]) = 'FRI') or (CheckDay(aDList[idx]) = 'FR')) then
552           begin
553             cbo5.Checked := true;
554             aDList[idx] := 'FR';
555             FDaySchedule[cbo5.tag] := 'FR';
556           end
557         else if ((CheckDay(aDList[idx]) = 'SAT') or (CheckDay(aDList[idx]) = 'SA')) then
558           begin
559             cbo6.Checked := true;
560             aDList[idx] := 'SA';
561             FDaySchedule[cbo6.tag] := 'SA';
562           end
563         else aDList.Delete(idx);
564       end;
565     end;
566   
567   begin
568     inherited;
569     dayStr  := '';
570     timeStr := '';
571     if Length (txtSchedule.Text) = 0 then
572     begin
573       FOtherSchedule := '';
574       btnReset.Click;
575       Exit;
576     end;
577     OrigSch := txtSchedule.Text;
578     dayList  := TStringList.Create;
579     if Pos('@',txtSchedule.Text)>0 then
580     begin
581       dayStr  := Trim(Piece(txtSchedule.Text,'@',1));
582       timeStr := Trim(Piece(txtSchedule.Text,'@',2));
583     end  else
584     begin
585       Val(Piece(txtSchedule.Text,'-',1), i, Code);
586       if i = 0 then begin end;  // just to make compiler not give hint
587       if Code <> 0 then dayStr := Trim(txtSchedule.Text)
588       else timeStr := Trim(txtSchedule.Text);
589     end;
590     FTimeSchedule.Clear;
591     for cnt := Low(FDaySchedule) to High(FDaySchedule) do
592       FDaySchedule[cnt] := '';
593     PiecesToList(timeStr, '-', FTimeSchedule);
594     if Length(dayStr)>0 then
595     begin
596       PiecesToList(dayStr, '-', dayList);
597       cbo7.Checked := False;
598       cbo1.Checked := False;
599       cbo2.Checked := False;
600       cbo3.Checked := False;
601       cbo4.Checked := False;
602       cbo5.Checked := False;
603       cbo6.Checked := False;
604       updateCheckbox(dayList);
605     end;
606   
607     FOtherSchedule := txtSchedule.Text;
608   end;
609   
610   procedure TfrmOtherSchedule.lstHourClick(Sender: TObject);
611   begin
612     inherited;
613     if lstMinute.ItemIndex = -1 then lstMinute.ItemIndex :=0;
614   end;
615   
616   procedure TfrmOtherSchedule.txtScheduleChange(Sender: TObject);
617   begin
618     inherited;
619     FFromEditBox := True;
620     if not FFromCheckBox then
621       UpdateOnFreeTextInput;
622     FFromEditBox := False;
623   end;
624   
625   function TfrmOtherSchedule.CheckDay(ADayStr: string): string;
626   var
627     lng: integer;
628   begin
629     lng := Length(ADayStr);
630     if lng <2 then
631     begin
632       result := '';
633       Exit;
634     end;
635     if (lng < 7) and ( UpperCase(aDayStr)= Copy('SUNDAY',1,lng)) then
636       result := 'SU'
637     else if (lng < 7) and (UpperCase(aDayStr)= Copy('MONDAY',1,lng)) then
638       result := 'MO'
639     else if (lng < 8) and (UpperCase(aDayStr)= Copy('TUESDAY',1,lng)) then
640       result := 'TU'
641     else if (lng < 10) and (UpperCase(aDayStr)= Copy('WEDNESDAY',1,lng)) then
642       result := 'WE'
643     else if (lng < 9) and (UpperCase(aDayStr)= Copy('THURSDAY',1,lng)) then
644       result := 'TH'
645     else if (lng < 7) and (UpperCase(aDayStr)= Copy('FRIDAY',1,lng)) then
646       result := 'FR'
647     else if (lng < 9) and (UpperCase(aDayStr)= Copy('SATURDAY',1,lng)) then
648       result := 'SA'
649     else
650       result := '';
651   end;
652   
653   procedure TfrmOtherSchedule.EnabledSch(TF: boolean);
654   begin
655      self.GroupBox3.Enabled := TF;
656      self.NSScboSchedule.Enabled := TF;
657      self.btnSchAdd.Enabled := TF;
658      self.btnSchRemove.Enabled := TF;
659   //   if TF = False then self.NSScboSchedule.Color := cl3DLight
660   //   else self.NSScboSchedule.Color := clWindow;
661      if TF = False then self.NSScboSchedule.ItemIndex := -1;
662   end;
663   
664   procedure TfrmOtherSchedule.EnabledTime(TF: boolean);
665   begin
666     self.GroupBox2.Enabled := TF;
667     self.lstHour.Enabled := TF;
668     self.lstMinute.Enabled := TF;
669     self.btnAdd.Enabled := TF;
670     self.btnRemove.Enabled := TF;
671     if TF = False then
672       begin
673         self.lstHour.ItemIndex := -1;
674         self.lstMinute.ItemIndex := -1;
675       end;
676   end;
677   
678   procedure TfrmOtherSchedule.lstMinuteMouseUp(Sender: TObject;
679     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
680   begin
681     inherited;
682     FFromCheckBox := True;
683     if lstHour.ItemIndex < 0 then Exit;
684     //btnAddClick(Self);
685     FFromCheckBox := False;
686   end;
687   
688   procedure TfrmOtherSchedule.NSScboScheduleExit(Sender: TObject);
689   begin
690     inherited;
691     if Pos(CRLF, NSScboSchedule.Text)> 0 then
692       begin
693         NSScboSchedule.Text := '';
694         NSScboSchedule.ItemIndex := -1;
695         Application.MessageBox('Schedule field cannot contain a control character. Please select a valid unique schedule from the list.' +CRLF +
696                                'Or remove the schedule text from the schedule list and select specific times from the administration times list.',
697                                 'Incorrect Schedule.');
698         NSScboSchedule.SetFocus;
699       end;
700     if (NSScboSchedule.Text <> '') and (NSScboSchedule.ItemIndex = -1) then
701       begin
702         Application.MessageBox('Please select a valid unique schedule from the list.' +CRLF +
703                                'Or remove the schedule text from the schedule list and select specific times from the administration times list.',
704                                 'Incorrect Schedule.');
705         NSSCboSchedule.Text := '';
706         NSScboSchedule.SetFocus;
707       end;
708   
709   end;
710   
711   procedure TfrmOtherSchedule.NSScboScheduleKeyUp(Sender: TObject; var Key: Word;
712     Shift: TShiftState);
713   begin
714     inherited;
715     if (Key = VK_BACK) and (NSScboSchedule.Text = '') then NSScboSchedule.itemindex:= -1;
716   end;
717   
718   procedure TfrmOtherSchedule.lstMinuteKeyDown(Sender: TObject;
719     var Key: Word; Shift: TShiftState);
720   begin
721     inherited;
722     if (Key=VK_RETURN) then
723     begin
724       FFromCheckBox := True;
725       if lstHour.ItemIndex < 0 then Exit;
726       //btnAddClick(Self);
727       FFromCheckBox := False;
728     end;
729   end;
730   
731   procedure TfrmOtherSchedule.Button1Click(Sender: TObject);
732   begin
733     inherited;
734      cbo1.Checked := true;
735      cbo2.Checked := true;
736      cbo3.Checked := true;
737      cbo4.Checked := true;
738      cbo5.Checked := true;
739      cbo6.Checked := true;
740      cbo7.Checked := true;
741   end;
742   
743   end.

Module Calls (2 levels)


fOtherSchedule
 ├fAutoSz
 │ └fBase508Form
 ├rMisc
 │ └fOrders
 └rODMeds
   ├uCore
   └uConst

Module Called-By (2 levels)


             fOtherSchedule
                   fFrame┤ 
              CPRSChart┤ │ 
                  fPage┤ │ 
                uOrders┤ │ 
                fODBase┤ │ 
                UBACore┤ │ 
                fOrders┤ │ 
                   uPCE┤ │ 
      fBALocalDiagnoses┤ │ 
             fEncVitals┤ │ 
                fVitals┤ │ 
                 fCover┤ │ 
                 rCover┤ │ 
              fPtSelMsg┤ │ 
                 fPtSel┤ │ 
            fOrdersSign┤ │ 
         fPrintLocation┤ │ 
                  fMeds┤ │ 
                fRptBox┤ │ 
                 fNotes┤ │ 
               fReports┤ │ 
                 fEncnt┤ │ 
                 fProbs┤ │ 
          fReportsPrint┤ │ 
                fGraphs┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fReminderDialog┤ │ 
                  fLabs┤ │ 
              fLabPrint┤ │ 
                fReview┤ │ 
            fIconLegend┤ │ 
           fOrdersPrint┤ │ 
               fSurgery┤ │ 
uVA508CPRSCompatibility┤ │ 
           fOrdersRenew┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                 fODRad┤ │ 
                 fODLab┤ │ 
                fODMeds┤ │ 
               fODMedIV┤ │ 
              fODVitals┤ │ 
                fODAuto┤ │ 
                 fOMSet┤ │ 
         fOrdersRelease┤ │ 
              fODMedNVA┤ │ 
         fOrdersOnChart┤ │ 
             fOCSession┤ │ 
              fODActive┤ │ 
               fPCEEdit┘ │ 
               fODMeds...┤ 
              fODMedIV...┘