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

Last change on this file since 1071 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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