source: cprs/branches/tmg-cprs/CPRS-Chart/Options/rOptions.pas@ 466

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

Initial upload of TMG-CPRS 1.0.26.69

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