source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fOCMonograph.pas@ 1693

Last change on this file since 1693 was 1693, checked in by healthsevak, 9 years ago

Committing the files for first time to this new branch

File size: 2.4 KB
Line 
1unit fOCMonograph;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, ORFn, ORCtrls, rOrders, VA508AccessibilityManager, ExtCtrls;
8
9type
10 TfrmOCMonograph = class(TForm)
11 monoCmbLst: TComboBox;
12 monoMemo: TCaptionMemo;
13 cmdOK: TButton;
14 VA508StaticText1: TVA508StaticText;
15 VA508StaticText2: TVA508StaticText;
16 VA508AccessibilityManager1: TVA508AccessibilityManager;
17 VA508ComponentAccessibility1: TVA508ComponentAccessibility;
18 procedure DisplayMonograph;
19 procedure monoCmbLstChange(Sender: TObject);
20 procedure cmdOKClick(Sender: TObject);
21 procedure VA508ComponentAccessibility1CaptionQuery(Sender: TObject;
22 var Text: string);
23 private
24 { Private declarations }
25 public
26 { Public declarations }
27 end;
28var
29 mList: TStringList;
30procedure ShowMonographs(monoList: TStringList);
31
32implementation
33
34{$R *.dfm}
35
36procedure ShowMonographs(monoList: TStringList);
37var
38 i: Integer;
39 frmOCMonograph: TfrmOCMonograph;
40begin
41 if monoList.Count > 0 then
42 begin
43 mList := monoList;
44 frmOCMonograph := TfrmOCMonograph.Create(Application);
45 try
46 for i := 0 to monoList.Count - 1 do
47 begin
48 frmOCMonograph.monoCmbLst.Items.Add(Piece(monoList[i], U, 2));
49 end;
50
51 //frmOCMonograph.monoMemo.Clear;
52 frmOCMonograph.monoCmbLst.ItemIndex := 0;
53 frmOCMonograph.DisplayMonograph;
54 frmOCMonograph.ShowModal;
55 finally
56 frmOCMonograph.Free;
57 end;
58 end;
59end;
60
61procedure TfrmOCMonograph.DisplayMonograph;
62var
63 i: Integer;
64 x: Integer;
65 monograph: TStringList;
66begin
67 x := -1;
68 monograph := TStringList.Create;
69 monoMemo.Clear;
70 for i := 0 to mList.Count - 1 do
71 begin
72 if Piece(mList[i],'^',2)=monoCmbLst.Items[monoCmbLst.ItemIndex] then x := StrtoInt(Piece(mList[i],'^',1));
73 end;
74 if (x > -1) then
75 begin
76 GetMonograph(monograph,x);
77 for i := 0 to monograph.Count - 1 do
78 begin
79 monoMemo.Text := monoMemo.Text + monograph[i] + CRLF;
80 end;
81
82 end;
83
84end;
85
86procedure TfrmOCMonograph.cmdOKClick(Sender: TObject);
87begin
88 self.Close;
89end;
90
91procedure TfrmOCMonograph.monoCmbLstChange(Sender: TObject);
92begin
93 DisplayMonograph;
94end;
95
96procedure TfrmOCMonograph.VA508ComponentAccessibility1CaptionQuery(
97 Sender: TObject; var Text: string);
98begin
99 Text := monoCmbLst.SelText;
100end;
101
102end.
Note: See TracBrowser for help on using the repository browser.