source: cprs/trunk/CPRS-Chart/Options/rOptions.pas@ 730

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

Initial Upload of Official WV CPRS 1.0.26.76

File size: 17.5 KB
RevLine 
[456]1unit rOptions;
2
3interface
4
5uses SysUtils, Classes, ORNet, ORFn, uCore, rCore, rTIU, rConsults;
6
7function rpcGetNotifications: TStrings;
8function rpcGetOrderChecks: TStrings;
9function rpcGetNotificationDefaults: String;
10function rpcGetSurrogateInfo: String;
11procedure rpcCheckSurrogate(surrogate: Int64; var ok: boolean; var msg: string);
12procedure rpcSetSurrogateInfo(aString: String);
13procedure rpcClearNotifications;
14procedure rpcSetNotifications(aList: TStringList);
15procedure rpcSetOrderChecks(aList: TStringList);
16procedure rpcSetOtherStuff(aString: String);
17
18function rpcGetOtherTabs: TStrings;
19function rpcGetOther: String;
20procedure rpcSetOther(info: String);
21function rpcGetCosigners(const StartFrom: string; Direction: Integer): TStrings;
22function rpcGetDefaultCosigner: String;
23procedure rpcSetDefaultCosigner(value: Int64);
24function rpcGetSubject: boolean;
25procedure rpcSetSubject(value: boolean);
26function rpcGetClasses: TStrings;
27function rpcGetTitlesForClass(value: integer; const StartFrom: string; Direction: Integer): TStrings;
28function rpcGetTitlesForUser(value: integer): TStrings;
29function rpcGetTitleDefault(value: integer): integer;
30procedure rpcSaveDocumentDefaults(classvalue, titledefault: integer; aList: TStrings);
31
32procedure rpcGetLabDays(var InpatientDays: integer; var OutpatientDays: integer);
33procedure rpcGetLabUserDays(var InpatientDays: integer; var OutpatientDays: integer);
34procedure rpcGetApptDays(var StartDays: integer; var StopDays: integer);
35procedure rpcGetApptUserDays(var StartDays: integer; var StopDays: integer);
36procedure rpcSetDays(InpatientDays, OutpatientDays, StartDays, StopDays: integer);
37procedure rpcGetImagingDays(var MaxNum: integer; var StartDays: integer; var StopDays: integer);
38procedure rpcGetImagingUserDays(var MaxNum: integer; var StartDays: integer; var StopDays: integer);
39procedure rpcSetImagingDays(MaxNum, StartDays, StopDays: integer);
40
41procedure rpcGetReminders(Dest: TStrings);
42procedure rpcSetReminders(aList: TStringList);
43
44function rpcGetListOrder: Char;
45procedure rpcGetClinicUserDays(var StartDays: integer; var StopDays: integer);
46procedure rpcGetClinicDefaults(var mon, tues, wed, thurs, fri, sat, sun: integer);
47procedure rpcGetListSourceDefaults(var provider, treating, list, ward: integer);
48procedure rpcSetClinicDefaults(StartDays, StopDays, mon, tues, wed, thurs, fri, sat, sun: integer);
49procedure rpcSetPtListDefaults(PLSource, PLSort: Char; prov, spec, team, ward: integer);
50
51procedure rpcGetPersonalLists(Dest: TStrings);
52procedure rpcGetAllTeams(Dest: TStrings);
53procedure rpcGetTeams(Dest: TStrings);
54procedure rpcGetATeams(Dest: TStrings);
55procedure rpcDeleteList(aString: String);
56function rpcNewList(aString: String): String;
57procedure rpcSaveListChanges(aList: TStrings; aListIEN: integer);
58procedure rpcListUsersByTeam(Dest: TStrings; teamid: integer);
59procedure rpcRemoveList(aListIEN: integer);
60procedure rpcAddList(aListIEN: integer);
61
62function rpcGetCombo: TStrings;
63procedure rpcSetCombo(aList: TStrings);
64
65procedure rpcGetDefaultReportsSetting(var int1: integer; var int2: integer; var int3: integer);
66procedure rpcDeleteUserLevelReportsSetting;
67procedure rpcActiveDefaultSetting;
68procedure rpcSetDefaultReportsSetting(aString: string);
69procedure rpcSetIndividualReportSetting(aString1:string; aString2:string);
70procedure rpcRetrieveDefaultSetting(var int1: integer; var int2: integer; var int3: integer; var msg: string);
71
72procedure rpcGetRangeForMeds(var startDt, stopDt: TFMDateTime);
73procedure rpcPutRangeForMeds(TheVal: string);
74procedure rpcGetRangeForEncs(var StartDays, StopDays: integer; DefaultParams: Boolean);
75procedure rpcPutRangeForEncs(StartDays, StopDays: string);
76procedure rpcGetEncFutureDays(var FutureDays: string);
77
78implementation
79
80//..............................................................................
81
82function rpcGetNotifications: TStrings;
83begin
84 CallV('ORWTPP GETNOT', [nil]);
85 MixedCaseList(RPCBrokerV.Results);
86 result :=RPCBrokerV.Results;
87end;
88
89function rpcGetOrderChecks: TStrings;
90begin
91 CallV('ORWTPP GETOC', [nil]);
92 MixedCaseList(RPCBrokerV.Results);
93 result :=RPCBrokerV.Results;
94end;
95
96function rpcGetNotificationDefaults: String;
97begin
98 result := sCallV('ORWTPP GETNOTO', [nil]);
99end;
100
101function rpcGetSurrogateInfo: String;
102begin
103 result := MixedCase(sCallV('ORWTPP GETSURR', [nil]));
104end;
105
106procedure rpcCheckSurrogate(surrogate: Int64; var ok: boolean; var msg: string);
107var
108 value: string;
109begin
110 value := sCallV('ORWTPP CHKSURR', [surrogate]);
111 ok := Piece(value, '^', 1) = '1';
112 msg := Piece(value, '^', 2);
113end;
114
115procedure rpcSetSurrogateInfo(aString: String);
116begin
117 CallV('ORWTPP SAVESURR', [aString]);
118end;
119
120
121procedure rpcClearNotifications;
122begin
123 CallV('ORWTPP CLEARNOT', [nil]);
124end;
125
126procedure rpcSetNotifications(aList: TStringList);
127begin
128 CallV('ORWTPP SAVENOT', [aList]);
129end;
130
131procedure rpcSetOrderChecks(aList: TStringList);
132begin
133 CallV('ORWTPP SAVEOC', [aList]);
134end;
135
136procedure rpcSetOtherStuff(aString: String);
137begin
138 CallV('ORWTPP SAVENOTO', [aString]);
139end;
140
141//..............................................................................
142
143function rpcGetOtherTabs: TStrings;
144begin
145 CallV('ORWTPO GETTABS', [nil]);
146 MixedCaseList(RPCBrokerV.Results);
147 result :=RPCBrokerV.Results;
148end;
149
150function rpcGetOther: String;
151begin
152 result := sCallV('ORWTPP GETOTHER', [nil]);
153end;
154
155procedure rpcSetOther(info: String);
156begin
157 CallV('ORWTPP SETOTHER', [info]);
158end;
159
160function rpcGetCosigners(const StartFrom: string; Direction: Integer): TStrings;
161begin
162 CallV('ORWTPP GETCOS', [StartFrom, Direction]);
163 MixedCaseList(RPCBrokerV.Results);
164 Result := RPCBrokerV.Results;
165end;
166
167function rpcGetDefaultCosigner: String;
168begin
169 result := sCallV('ORWTPP GETDCOS', [nil]);
170end;
171
172procedure rpcSetDefaultCosigner(value: Int64);
173begin
174 CallV('ORWTPP SETDCOS', [value])
175end;
176
177function rpcGetSubject: boolean;
178var
179 value: string;
180begin
181 value := sCallV('ORWTPP GETSUB', [nil]);
182 if value = '1' then result := true
183 else result := false;
184end;
185
186procedure rpcSetSubject(value: boolean);
187begin
188 CallV('ORWTPP SETSUB', [value])
189end;
190
191function rpcGetClasses: TStrings;
192begin
193 CallV('ORWTPN GETCLASS', [nil]);
194 MixedCaseList(RPCBrokerV.Results);
195 result :=RPCBrokerV.Results;
196end;
197
198function rpcGetTitlesForClass(value: integer; const StartFrom: string; Direction: Integer): TStrings;
199begin
200(* case value of
201 CLS_PROGRESS_NOTES: CallV('TIU LONG LIST OF TITLES', [value, StartFrom, Direction]);
202 else
203 CallV('ORWTPN GETTC', [value, StartFrom, Direction]); //****** original
204 end;*)
205 CallV('TIU LONG LIST OF TITLES', [value, StartFrom, Direction]);
206 //MixedCaseList(RPCBrokerV.Results);
207 result :=RPCBrokerV.Results;
208end;
209
210function rpcGetTitlesForUser(value: integer): TStrings;
211begin
212 CallV('ORWTPP GETTU', [value]);
213 //MixedCaseList(RPCBrokerV.Results);
214 result :=RPCBrokerV.Results;
215end;
216
217function rpcGetTitleDefault(value: integer): integer;
218begin
219 result := strtointdef(sCallV('ORWTPP GETTD', [value]), -1);
220end;
221
222procedure rpcSaveDocumentDefaults(classvalue, titledefault: integer; aList: TStrings);
223begin
224 CallV('ORWTPP SAVET', [classvalue, titledefault, aList]);
225end;
226
227//..............................................................................
228
229procedure rpcGetLabDays(var InpatientDays: integer; var OutpatientDays:integer);
230var
231 values: string;
232begin
233 values := sCallV('ORWTPO CSLABD', [nil]);
234 InpatientDays := strtointdef(Piece(values, '^', 1), 0);
235 OutpatientDays := strtointdef(Piece(values, '^', 2), 0);
236end;
237
238procedure rpcGetLabUserDays(var InpatientDays: integer; var OutpatientDays: integer);
239var
240 values: string;
241begin
242 values := sCallV('ORWTPP CSLAB', [nil]);
243 InpatientDays := -strtointdef(Piece(values, '^', 1), 0);
244 OutpatientDays := -strtointdef(Piece(values, '^', 2), 0);
245end;
246
247procedure rpcGetApptDays(var StartDays: integer; var StopDays: integer);
248var
249 values, start, stop: string;
250begin
251 values := sCallV('ORWTPD1 GETCSDEF', [nil]);
252 start := Piece(values, '^', 1);
253 stop := Piece(values, '^', 2);
254 StartDays := strtointdef(Piece(start, 'T', 2), 0);
255 StopDays := strtointdef(Piece(stop, 'T', 2), 0);
256end;
257
258procedure rpcGetApptUserDays(var StartDays: integer; var StopDays: integer);
259var
260 values, start, stop: string;
261begin
262 values := sCallV('ORWTPD1 GETCSRNG', [nil]);
263 start := Piece(values, '^', 1);
264 stop := Piece(values, '^', 2);
265 StartDays := strtointdef(Piece(start, 'T', 2), 0);
266 StopDays := strtointdef(Piece(stop, 'T', 2), 0);
267end;
268
269procedure rpcSetDays(InpatientDays, OutpatientDays, StartDays, StopDays: integer);
270var
271 values: string;
272begin
273 values := '';
274 values := values + inttostr(InpatientDays) + '^';
275 values := values + inttostr(OutpatientDays) + '^';
276 values := values + inttostr(StartDays) + '^';
277 values := values + inttostr(StopDays) + '^';
278 CallV('ORWTPD1 PUTCSRNG', [values]);
279end;
280
281procedure rpcGetImagingDays(var MaxNum: integer; var StartDays: integer; var StopDays: integer);
282var
283 values, max, start, stop: string;
284begin
285 values := sCallV('ORWTPO GETIMGD', [nil]);
286 //values := 'T-120;T;;;100';
287 start := Piece(values, ';', 1);
288 stop := Piece(values, ';', 2);
289 max := Piece(values, ';', 5);
290 StartDays := strtointdef(Piece(start, 'T', 2), 0);
291 StopDays := strtointdef(Piece(stop, 'T', 2), 0);
292 MaxNum := strtointdef(max, 0);
293end;
294
295procedure rpcGetImagingUserDays(var MaxNum: integer; var StartDays: integer; var StopDays: integer);
296var
297 values, max, start, stop: string;
298begin
299 values := sCallV('ORWTPP GETIMG', [nil]);
300 //values := 'T-180;T;;;15';
301 start := Piece(values, ';', 1);
302 stop := Piece(values, ';', 2);
303 max := Piece(values, ';', 5);
304 StartDays := strtointdef(Piece(start, 'T', 2), 0);
305 StopDays := strtointdef(Piece(stop, 'T', 2), 0);
306 MaxNum := strtointdef(max, 0);
307end;
308
309procedure rpcSetImagingDays(MaxNum, StartDays, StopDays: integer);
310begin
311 CallV('ORWTPP SETIMG', [MaxNum, StartDays, StopDays]);
312end;
313
314//..............................................................................
315
316procedure rpcGetReminders(Dest: TStrings);
317begin
318 CallV('ORWTPP GETREM', [nil]);
319 MixedCaseList(RPCBrokerV.Results);
320 Dest.Assign(RPCBrokerV.Results);
321end;
322
323procedure rpcSetReminders(aList: TStringList);
324begin
325 CallV('ORWTPP SETREM', [aList]);
326end;
327
328//..............................................................................
329
330function rpcGetListOrder: Char;
331begin
332 result := CharAt(sCallV('ORWTPP SORTDEF', [nil]), 1);
333end;
334
335procedure rpcGetClinicUserDays(var StartDays: integer; var StopDays: integer);
336var
337 values, start, stop: string;
338begin
339 values := sCallV('ORWTPP CLRANGE', [nil]);
340 start := Piece(values, '^', 1);
341 stop := Piece(values, '^', 2);
342 StartDays := strtointdef(Piece(start, 'T', 2), 0);
343 StopDays := strtointdef(Piece(stop, 'T', 2), 0);
344end;
345
346procedure rpcGetClinicDefaults(var mon, tues, wed, thurs, fri, sat, sun: integer);
347var
348 values: string;
349begin
350 values := sCallV('ORWTPP CLDAYS', [nil]);
351 mon := strtointdef(Piece(values, '^', 1), 0);
352 tues := strtointdef(Piece(values, '^', 2), 0);
353 wed := strtointdef(Piece(values, '^', 3), 0);
354 thurs := strtointdef(Piece(values, '^', 4), 0);
355 fri := strtointdef(Piece(values, '^', 5), 0);
356 sat := strtointdef(Piece(values, '^', 6), 0);
357 sun := strtointdef(Piece(values, '^', 7), 0);
358end;
359
360procedure rpcGetListSourceDefaults(var provider, treating, list, ward: integer);
361var
362 values: string;
363begin
364 values := sCallV('ORWTPP LSDEF', [nil]);
365 provider := strtointdef(Piece(values, '^', 1), 0);
366 treating := strtointdef(Piece(values, '^', 2), 0);
367 list := strtointdef(Piece(values, '^', 3), 0);
368 ward := strtointdef(Piece(values, '^', 4), 0);
369end;
370
371procedure rpcSetClinicDefaults(StartDays, StopDays, mon, tues, wed, thurs, fri, sat, sun: integer);
372var
373 values: string;
374begin
375 values := '';
376 values := values + inttostr(StartDays) + '^';
377 values := values + inttostr(StopDays) + '^';
378 values := values + inttostr(mon) + '^';
379 values := values + inttostr(tues) + '^';
380 values := values + inttostr(wed) + '^';
381 values := values + inttostr(thurs) + '^';
382 values := values + inttostr(fri) + '^';
383 values := values + inttostr(sat) + '^';
384 values := values + inttostr(sun) + '^';
385 CallV('ORWTPP SAVECD', [values]);
386end;
387
388procedure rpcSetPtListDefaults(PLSource, PLSort: Char; prov, spec, team, ward: integer);
389var
390 values: string;
391begin
392 values := '';
393 values := values + PLSource + '^';
394 values := values + PLSort + '^';
395 values := values + inttostr(prov) + '^';
396 values := values + inttostr(spec) + '^';
397 values := values + inttostr(team) + '^';
398 values := values + inttostr(ward) + '^';
399 CallV('ORWTPP SAVEPLD', [values]);
400end;
401
402//..............................................................................
403
404procedure rpcGetPersonalLists(Dest: TStrings);
405begin
406 CallV('ORWTPP PLISTS', [nil]);
407 MixedCaseList(RPCBrokerV.Results);
408 Dest.Assign(RPCBrokerV.Results);
409end;
410
411procedure rpcGetAllTeams(Dest: TStrings);
412begin
413 CallV('ORWTPP PLTEAMS', [nil]);
414 MixedCaseList(RPCBrokerV.Results);
415 Dest.Assign(RPCBrokerV.Results);
416end;
417
418procedure rpcGetTeams(Dest: TStrings);
419begin
420 CallV('ORWTPP TEAMS', [nil]);
421 MixedCaseList(RPCBrokerV.Results);
422 Dest.Assign(RPCBrokerV.Results);
423end;
424
425procedure rpcGetATeams(Dest: TStrings);
426begin
427 CallV('ORWTPT ATEAMS', [nil]);
428 MixedCaseList(RPCBrokerV.Results);
429 Dest.Assign(RPCBrokerV.Results);
430end;
431
432procedure rpcDeleteList(aString: String);
433begin
434 CallV('ORWTPP DELLIST', [aString]);
435end;
436
437function rpcNewList(aString: String): String;
438begin
439 result := sCallV('ORWTPP NEWLIST', [aString]);
440 result := MixedCase(result);
441end;
442
443procedure rpcSaveListChanges(aList: TStrings; aListIEN: integer);
444begin
445 CallV('ORWTPP SAVELIST', [aList, aListIEN]);
446end;
447
448procedure rpcListUsersByTeam(Dest: TStrings; teamid: integer);
449begin
450 CallV('ORWTPT GETTEAM', [teamid]);
451 MixedCaseList(RPCBrokerV.Results);
452 Dest.Assign(RPCBrokerV.Results);
453end;
454
455procedure rpcRemoveList(aListIEN: integer);
456begin
457 CallV('ORWTPP REMLIST', [aListIEN]);
458end;
459
460procedure rpcAddList(aListIEN: integer);
461begin
462 CallV('ORWTPP ADDLIST', [aListIEN]);
463end;
464
465//..............................................................................
466
467function rpcGetCombo: TStrings;
468begin
469 CallV('ORWTPP GETCOMBO', [nil]);
470 MixedCaseList(RPCBrokerV.Results);
471 result := RPCBrokerV.Results;
472end;
473
474procedure rpcSetCombo(aList: TStrings);
475begin
476 CallV('ORWTPP SETCOMBO', [aList]);
477end;
478
479//..............................................................................
480
481procedure rpcGetDefaultReportsSetting(var int1: integer; var int2: integer; var int3: integer);
482var
483 values: string;
484 startoffset,stopoffset: string;
485begin
486 values := sCallV('ORWTPD GETDFLT', [nil]);
487 if length(values)=0 then
488 exit;
489 startoffset := Piece(values,';',1);
490 delete(startoffset,1,1);
491 stopoffset := Piece(values,';',2);
492 delete(stopoffset,1,1);
493 int1 := strtointdef(startoffset,0);
494 int2 := strtointdef(stopoffset,0);
495 int3:= strtointdef(Piece(values, ';', 3), 100); // max occurences
496end;
497
498procedure rpcDeleteUserLevelReportsSetting;
499begin
500 sCallV('ORWTPD DELDFLT',[nil]);
501end;
502
503procedure rpcActiveDefaultSetting;
504begin
505 sCallV('ORWTPD ACTDF',[nil]);
506end;
507
508procedure rpcSetDefaultReportsSetting(aString: string);
509begin
510 sCallV('ORWTPD SUDF',[aString]);
511end;
512
513procedure rpcSetIndividualReportSetting(aString1:string; aString2:string);
514begin
515 sCallV('ORWTPD SUINDV',[aString1,aString2]);
516end;
517
518procedure rpcRetrieveDefaultSetting(var int1: integer; var int2: integer; var int3: integer; var msg: string);
519var
520 values: string;
521 startoffset,stopoffset: string;
522begin
523 values := sCallV('ORWTPD RSDFLT',[nil]);
524 if length(values)=0 then
525 begin
526 msg := 'NODEFAULT';
527 exit;
528 end;
529 startoffset := Piece(values,';',1);
530 delete(startoffset,1,1);
531 stopoffset := Piece(values,';',2);
532 delete(stopoffset,1,1);
533 int1 := strtointdef(startoffset,0);
534 int2 := strtointdef(stopoffset,0);
535 int3:= strtointdef(Piece(values, ';', 3), 100); // max occurences
536end;
537
538procedure rpcGetRangeForMeds(var startDt, stopDt: TFMDateTime);
539var
540 rst,sDt,eDt: string;
541 td: TFMDateTime;
542begin
543 rst := SCallV('ORWTPD GETOCM',[nil]);
544 sDt := Piece(rst,';',1);
545 if lowerCase(sDt) <> 't' then
546 Delete(sDt,1,1);
547 eDt := Piece(rst,';',2);
548 if lowerCase(eDt) <> 't' then
549 Delete(eDt,1,1);
550 td := FMToday;
551 if Length(sDt)>0 then
552 startDt := FMDateTimeOffsetBy(td, StrToIntDef(sDt,0));
553 if Length(eDt)>0 then
554 stopDt := FMDateTimeOffsetBy(td, StrToIntDef(eDt,0));
555end;
556
557procedure rpcPutRangeForMeds(TheVal: string);
558begin
559 SCallV('ORWTPD PUTOCM',[TheVal]);
560end;
561
562procedure rpcGetRangeForEncs(var StartDays, StopDays: integer; DefaultParams: Boolean);
563var
564 Start, Stop, Values: string;
565begin
566 if DefaultParams then
567 Values := SCallV('ORWTPD1 GETEFDAT',[nil])
568 else
569 Values := SCallV('ORWTPD1 GETEDATS',[nil]);
570 Start := Piece(Values, '^', 1);
571 Stop := Piece(Values, '^', 2);
572 StartDays := StrToIntDef(Start, 0);
573 StopDays := StrToIntDef(Stop, 0);
574end;
575
576procedure rpcPutRangeForEncs(StartDays, StopDays: string);
577var
578 values: string;
579begin
580 values := '';
581 values := values + StartDays + '^';
582 values := values + StopDays;
583 CallV('ORWTPD1 PUTEDATS',[values]);
584end;
585
586procedure rpcGetEncFutureDays(var FutureDays: string);
587begin
588 FutureDays := SCallV('ORWTPD1 GETEAFL',[nil]);
589end;
590
591end.
Note: See TracBrowser for help on using the repository browser.