source: cprs/trunk/CPRS-Chart/fClinicWardMeds.pas@ 773

Last change on this file since 773 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

File size: 6.2 KB
Line 
1unit fClinicWardMeds;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, fAutoSz, StdCtrls, ExtCtrls, ORCtrls,ORFn, rCore, uCore, oRNet, Math;
8
9type
10 TfrmClinicWardMeds = class(TfrmAutoSz)
11 stxtLine3: TStaticText;
12 stxtLine2: TStaticText;
13 stxtLine1: TStaticText;
14 btnClinic: TButton;
15 btnWard: TButton;
16 procedure btnClinicClick(Sender: TObject);
17 procedure btnWardClick(Sender: TObject);
18
19 private
20 { Private declarations }
21 procedure StartLocationCheck;
22 procedure rpcChangeOrderLocation(pOrderList:TStringList);
23 procedure BuildMessage(MsgSw:string);
24 function BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList;
25
26 public
27 { Public declarations }
28 // passes order list and selected locations to rpc to be saved with order.
29 procedure ClinicOrWardLocation(pOrderList:TStringList; pEncounterLoc: integer; pEncounterLocName: string; var RetLoc: integer); overload;
30 // returns Location selected by user.
31 function ClinicOrWardLocation(pEncounterLoc: integer):integer;overLoad;
32 function rpcIsPatientOnWard(Patient: string): boolean;
33 function SelectPrintLocation(pEncounterLoc:integer):integer;
34 end;
35
36var
37 frmClinicWardMeds: TfrmClinicWardMeds;
38 ALocation,AWardLoc, AClinicLoc : integer;
39 ASelectedLoc: integer;
40 AName, ASvc, AWardName, AClinicName: string;
41 AOrderLocList: TStringList;
42 AMsgSw: string;
43
44const
45 LOCATION_CHANGE_1 = 'This patient is currently admitted to ward';
46 LOCATION_CHANGE_2 = 'These orders are written at clinic';
47 LOCATION_CHANGE_3 = 'Where do you want the orders administered?';
48 //GE CQ9537 - Message text
49 PRINT_LOCATION_1 = 'The patient has been admitted to Ward ';
50 PRINT_LOCATION_2 = 'Should the orders be printed using the new location?';
51 LOC_PRINT_MSG = 'P';
52 LOC_MSG = 'L';
53
54implementation
55
56uses fFrame;
57
58{$R *.dfm}
59
60//entry point
61function TfrmClinicWardMeds.ClinicOrWardLocation(pEncounterLoc:integer):integer;
62begin
63 // Patient's current location
64 AClinicLoc := pEncounterLoc;
65 AClinicName := Encounter.LocationName;
66 AMsgSw := LOC_MSG;
67 StartLocationCheck;
68 Result := ASelectedLoc;
69 frmClinicWardMeds.Close;
70end;
71
72//entry point
73procedure TfrmClinicWardMeds.ClinicOrWardLocation(pOrderList:TStringList;pEncounterLoc:integer;pEncounterLocName:string; var RetLoc: integer);
74begin
75 AClinicLoc := pEncounterLoc;
76 AClinicName := pEncounterLocName;
77 AOrderLocList := TStringList.create;
78 AOrderLocList.Clear;
79 AMsgSw := LOC_MSG;
80 StartLocationCheck;
81 if pOrderList.Count > 0 then
82 begin
83 rpcChangeOrderLocation(BuildOrderLocList(pOrderList, ASelectedLoc));
84 RetLoc := ASelectedLoc
85 end;
86 if Assigned(AOrderLocList) then FreeAndNil(AOrderLocList);
87 frmClinicWardMeds.Close;
88end;
89
90// returns button selected by user - ward or clinic. print location
91//entry point -
92function TfrmClinicWardMeds.SelectPrintLocation(pEncounterLoc:integer):integer;
93begin
94 AClinicLoc := pEncounterLoc;
95 AMsgSw := LOC_PRINT_MSG;
96 StartLocationCheck;
97 Result := ASelectedLoc;
98 frmClinicWardMeds.Close;
99end;
100
101procedure TfrmClinicWardMeds.StartLocationCheck;
102begin
103
104 frmClinicWardMeds := TfrmClinicWardMeds.Create(Application);
105 // ResizeFormToFont(TForm(frmClinicWardMeds));
106 CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
107 AWardLoc := ALocation; //current location
108 AWardName := AName; // current location name
109 if AMsgSW = LOC_PRINT_MSG then BuildMessage(AMsgSw)
110 else
111 if (ALocation > 0) and (ALocation <> AClinicLoc) then BuildMessage(AMsgSw); //Location has changed, patient admitted
112end;
113
114procedure TfrmClinicWardMeds.btnClinicClick(Sender: TObject);
115begin
116 inherited;
117 ASelectedLoc := AClinicLoc;
118 frmClinicWardMeds.Close;
119end;
120
121procedure TfrmClinicWardMeds.btnWardClick(Sender: TObject);
122begin
123 inherited;
124 ASelectedLoc := AWardLoc;
125 frmClinicWardMeds.Close;
126end;
127
128procedure TfrmClinicWardMeds.BuildMessage(MsgSw:string);
129var
130 ALine1Len, ALine2Len, ALine3Len, ALongLine: integer;
131begin
132 with frmClinicWardMeds do
133 begin
134 btnWard.Caption := 'Ward';
135 btnClinic.Caption := 'Clinic';
136 // message text
137 if MsgSw = LOC_MSG then
138 begin
139 //AClinicName := 'this is my long test clinic Name';
140 stxtLine1.Caption := LOCATION_CHANGE_1 + ' :' + AWardName;
141 stxtLine2.Caption := LOCATION_CHANGE_2+ ' :' + AClinicName;
142 stxtLine3.Caption := LOCATION_CHANGE_3;
143 end
144 else
145 begin
146 stxtLine1.Caption := PRINT_LOCATION_1 + ':' + AWardName;
147 stxtLine2.Caption := PRINT_LOCATION_2;
148 stxtLine3.Caption := '';
149 end;
150 stxtLine2.Left := stxtLine1.left;
151 stxtLine3.Left := stxtLine1.left;
152 ALine1Len := TextWidthByFont(frmClinicWardMeds.stxtLine1.Font.Handle, frmClinicWardMeds.stxtLine1.Caption);
153 ALine2Len := TextWidthByFont(frmClinicWardMeds.stxtLine2.Font.Handle, frmClinicWardMeds.stxtLine2.Caption);
154 ALine3Len := TextWidthByFont(frmClinicWardMeds.stxtLine3.Font.Handle, frmClinicWardMeds.stxtLine3.Caption)+25;
155 ALongLine := Max(ALine1Len,ALine2Len);
156 ALongLine := Max(ALine3Len,ALongLine);
157 frmClinicWardMeds.Width := (ALongLine + frmClinicWardMeds.stxtLine1.Left + 15);
158 end;
159 frmClinicWardMeds.ShowModal;
160 frmClinicWardMeds.Release;
161
162end;
163
164function TfrmClinicWardMeds.BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList;
165var i:integer;
166 AOrderLoc: string;
167begin
168 AOrderLocList.clear;
169 for i := 0 to pOrderList.Count -1 do
170 begin
171 AOrderLoc := Piece(pOrderList.Strings[i],U,1) + U + IntToStr(pLocation);
172 AOrderLocList.Add(AOrderLoc);
173 end;
174 Result := AOrderLocList; //return value
175end;
176
177procedure TfrmClinicWardMeds.rpcChangeOrderLocation(pOrderList:TStringList);
178begin
179// OrderIEN^Location -- used to alter location if ward is selected.
180
181 CallV('ORWDX CHANGE',[pOrderList, Patient.DFN]);
182end;
183
184function TfrmClinicWardMeds.rpcIsPatientOnWard(Patient: string): boolean;
185begin
186 result := sCallV('ORWDX1 PATWARD',[Patient]) = '1';
187end;
188
189
190end.
Note: See TracBrowser for help on using the repository browser.