source: cprs/branches/tmg-cprs/CPRS-Chart/fClinicWardMeds.pas@ 1493

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

Initial upload of TMG-CPRS 1.0.26.69

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