- Timestamp:
- May 8, 2015, 7:52:55 AM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fOCAccept.pas
r829 r1693 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager ;7 fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager, rOrders, fOCMonograph; 8 8 9 9 type … … 13 13 cmdAccept: TButton; 14 14 cmdCancel: TButton; 15 Button1: TButton; 16 procedure Button1Click(Sender: TObject); 17 procedure cmdCancelClick(Sender: TObject); 18 procedure FormResize(Sender: TObject); 15 19 private 16 20 { Private declarations } … … 27 31 function AcceptOrderWithChecks(OCList: TStringList): Boolean; 28 32 var 29 i : Integer;33 i,j: Integer; 30 34 frmOCAccept: TfrmOCAccept; 31 begin 35 substring: String; 36 remOC: TStringList; 37 begin 38 remOC := TStringList.Create; 32 39 Result := True; 33 40 if OCList.Count > 0 then … … 36 43 try 37 44 ResizeFormToFont(TForm(frmOCAccept)); 45 frmOCAccept.Button1.Enabled := false; 46 if IsMonograph then frmOCAccept.Button1.Enabled := true; 47 38 48 for i := 0 to OCList.Count - 1 do 39 49 begin 40 frmOCAccept.memChecks.Lines.Add(Piece(OCList[i], U, 4)); 50 substring := Copy(Piece(OCList[i], U, 4),0,2); 51 if substring='||' then 52 begin 53 substring := Copy(Piece(OCList[i], U, 4),3,Length(Piece(OCList[i], U, 4))); 54 GetXtraTxt(remOC,Piece(substring,'&',1),Piece(substring,'&',2)); 55 frmOCAccept.memChecks.Lines.Add('('+inttostr(i+1)+' of '+inttostr(OCList.Count)+') ' + Piece(substring,'&',2)); 56 for j:= 0 to remOC.Count - 1 do frmOCAccept.memChecks.Lines.Add(' '+remOC[j]); 57 frmOCAccept.memChecks.Lines.Add(' '); 58 end 59 else 60 begin 61 frmOCAccept.memChecks.Lines.Add('('+inttostr(i+1)+' of '+inttostr(OCList.Count)+') ' + Piece(OCList[i], U, 4)); 62 end; 63 41 64 frmOCAccept.memChecks.Lines.Add(''); 42 65 end; … … 46 69 finally 47 70 frmOCAccept.Release; 71 remOC.Destroy; 48 72 end; 49 73 end; 50 74 end; 51 75 76 procedure TfrmOCAccept.Button1Click(Sender: TObject); 77 var 78 monoList: TStringList; 79 begin 80 inherited; 81 monoList := TStringList.Create; 82 GetMonographList(monoList); 83 ShowMonographs(monoList); 84 monoList.Free; 85 end; 86 87 procedure TfrmOCAccept.cmdCancelClick(Sender: TObject); 88 begin 89 inherited; 90 DeleteMonograph; 91 end; 92 93 procedure TfrmOCAccept.FormResize(Sender: TObject); 94 begin 95 inherited; 96 memChecks.Refresh; 97 end; 98 52 99 end.
Note:
See TracChangeset
for help on using the changeset viewer.