source: cprs/branches/foia-cprs/CPRS-Chart/rReminders.pas@ 459

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

Adding foia-cprs branch

File size: 11.7 KB
Line 
1unit rReminders;
2
3interface
4uses
5 Windows,Classes, SysUtils, TRPCB, ORNet, ORFn;
6
7procedure GetCurrentReminders;
8procedure GetOtherReminders(Dest: TStrings);
9procedure EvaluateReminders(RemList: TStringList);
10function EvaluateReminder(IEN: string): string;
11procedure GetEducationTopicsForReminder(ReminderID: integer);
12procedure GetEducationSubtopics(TopicID: integer);
13procedure GetReminderWebPages(ReminderID: string);
14function DetailReminder(IEN: Integer): TStrings;
15function ReminderInquiry(IEN: Integer): TStrings;
16function EducationTopicDetail(IEN: Integer): TStrings;
17function GetDialogInfo(IEN: string; RemIEN: boolean): TStrings;
18function GetDialogPrompts(IEN: string; Historical: boolean; FindingType: string): TStrings;
19procedure GetDialogStatus(AList: TStringList);
20function GetRemindersActive: boolean;
21function GetProgressNoteHeader: string;
22function LoadMentalHealthTest(TestName: string): TStrings;
23procedure MentalHealthTestResults(var AText: string; const DlgIEN: integer; const TestName:
24 string; const AProvider: Int64; const Answers: string);
25procedure SaveMentalHealthTest(const TestName: string; ADate: TFMDateTime;
26 const AProvider: Int64; const Answers: string);
27procedure SaveWomenHealthData(var WHData: TStringlist);
28function CheckGECValue(const RemIEN: string; NoteIEN: integer): String;
29procedure SaveMSTDataFromReminder(VDate, Sts, Prov, FType, FIEN, Res: string);
30
31function GetReminderFolders: string;
32procedure SetReminderFolders(const Value: string);
33function GetDefLocations: TStrings;
34function InsertRemTextAtCursor: boolean;
35
36function NewRemCoverSheetListActive: boolean;
37function CanEditAllRemCoverSheetLists: boolean;
38function GetCoverSheetLevelData(ALevel, AClass: string): TStrings;
39procedure SetCoverSheetLevelData(ALevel, AClass: string; Data: TStrings);
40function GetCategoryItems(CatIEN: integer): TStrings;
41function GetAllRemindersAndCategories: TStrings;
42
43implementation
44
45uses
46 uCore, uReminders, rCore;
47
48var
49 uLastDefLocUser: int64 = -1;
50 uDefLocs: TStringList = nil;
51 uRemInsertAtCursor: integer = -1;
52 uNewCoverSheetListActive: integer = -1;
53 uCanEditAllCoverSheetLists: integer = -1;
54
55procedure GetCurrentReminders;
56begin
57 CallV('ORQQPXRM REMINDERS UNEVALUATED', [Patient.DFN, Encounter.Location]);
58end;
59
60procedure GetOtherReminders(Dest: TStrings);
61begin
62 CallV('ORQQPXRM REMINDER CATEGORIES', [Patient.DFN, Encounter.Location]);
63 Dest.Assign(RPCBrokerV.Results);
64end;
65
66procedure EvaluateReminders(RemList: TStringList);
67var
68 i: integer;
69
70begin
71 with RPCBrokerV do
72 begin
73 ClearParameters := True;
74 RemoteProcedure := 'ORQQPXRM REMINDER EVALUATION';
75 Param[0].PType := literal;
76 Param[0].Value := Patient.DFN;
77 Param[1].PType := list;
78 for i := 0 to RemList.Count-1 do
79 Param[1].Mult[IntToStr(i+1)] := Piece(RemList[i],U,1);
80 CallBroker;
81 end;
82end;
83
84function EvaluateReminder(IEN: string): string;
85var
86 TmpSL: TStringList;
87
88begin
89 TmpSL := TStringList.Create;
90 try
91 TmpSL.Add(IEN);
92 EvaluateReminders(TmpSL);
93 if(RPCBrokerV.Results.Count > 0) then
94 Result := RPCBrokerV.Results[0]
95 else
96 Result := IEN;
97 finally
98 TmpSL.Free;
99 end;
100end;
101
102procedure GetEducationTopicsForReminder(ReminderID: integer);
103begin
104 CallV('ORQQPXRM EDUCATION SUMMARY', [ReminderID]);
105end;
106
107procedure GetEducationSubtopics(TopicID: integer);
108begin
109 CallV('ORQQPXRM EDUCATION SUBTOPICS', [TopicID]);
110end;
111
112procedure GetReminderWebPages(ReminderID: string);
113begin
114 if(User.WebAccess) then
115 CallV('ORQQPXRM REMINDER WEB', [ReminderID])
116 else
117 RPCBrokerV.ClearParameters := True;
118end;
119
120function DetailReminder(IEN: Integer): TStrings; // Clinical Maintenance
121begin
122 if InteractiveRemindersActive then
123 CallV('ORQQPXRM REMINDER DETAIL', [Patient.DFN, IEN])
124 else
125 CallV('ORQQPX REMINDER DETAIL', [Patient.DFN, IEN]);
126 Result := RPCBrokerV.Results;
127end;
128
129function ReminderInquiry(IEN: Integer): TStrings;
130begin
131 CallV('ORQQPXRM REMINDER INQUIRY', [IEN]);
132 Result := RPCBrokerV.Results;
133end;
134
135function EducationTopicDetail(IEN: Integer): TStrings;
136begin
137 CallV('ORQQPXRM EDUCATION TOPIC', [IEN]);
138 Result := RPCBrokerV.Results;
139end;
140
141function GetDialogInfo(IEN: string; RemIEN: boolean): TStrings;
142Var
143ver: string;
144
145begin
146 ver:=sCallV('ORQQPXRM CHECK REM VERSION', []);
147 if pos('2',ver)>0 then
148 begin
149 if RemIEN then
150 CallV('ORQQPXRM REMINDER DIALOG', [IEN, Patient.DFN])
151 else
152 CallV('PXRM REMINDER DIALOG (TIU)', [IEN, Patient.DFN]);
153 Result := RPCBrokerV.Results;
154 end
155 else
156 begin
157 if RemIEN then
158 CallV('ORQQPXRM REMINDER DIALOG', [IEN])
159 else
160 CallV('PXRM REMINDER DIALOG (TIU)', [IEN]);
161 Result := RPCBrokerV.Results;
162 end;
163end;
164
165function GetDialogPrompts(IEN: string; Historical: boolean; FindingType: string): TStrings;
166begin
167 CallV('ORQQPXRM DIALOG PROMPTS', [IEN, Historical, FindingType]);
168 Result := RPCBrokerV.Results;
169end;
170
171procedure GetDialogStatus(AList: TStringList);
172var
173 i: integer;
174
175begin
176 if(Alist.Count = 0) then exit;
177 with RPCBrokerV do
178 begin
179 ClearParameters := True;
180 RemoteProcedure := 'ORQQPXRM DIALOG ACTIVE';
181 Param[0].PType := list;
182 for i := 0 to AList.Count-1 do
183 Param[0].Mult[AList[i]] := '';
184 CallBroker;
185 AList.Assign(Results);
186 end;
187end;
188
189function GetRemindersActive: boolean;
190begin
191 CallV('ORQQPX NEW REMINDERS ACTIVE', []);
192 Result := ((RPCBrokerV.Results.Count = 1) and (RPCBrokerV.Results[0] = '1'));
193end;
194
195function GetProgressNoteHeader: string;
196begin
197 Result := sCallV('ORQQPXRM PROGRESS NOTE HEADER', [Encounter.Location]);
198end;
199
200function LoadMentalHealthTest(TestName: string): TStrings;
201begin
202 CallV('ORQQPXRM MENTAL HEALTH', [TestName]);
203 Result := RPCBrokerV.Results;
204end;
205
206procedure MentalHealthTestResults(var AText: string; const DlgIEN: integer; const TestName:
207 string; const AProvider: Int64; const Answers: string);
208var
209 i, R: integer;
210 Ans, tmp: string;
211
212begin
213 with RPCBrokerV do
214 begin
215 ClearParameters := True;
216 RemoteProcedure := 'ORQQPXRM MENTAL HEALTH RESULTS';
217 Param[0].PType := literal;
218 Param[0].Value := IntToStr(DlgIEN);
219 Param[1].PType := list;
220 Param[1].Mult['"DFN"'] := Patient.DFN;
221 Param[1].Mult['"CODE"'] := TestName;
222 Param[1].Mult['"ADATE"'] := 'T';
223 Param[1].Mult['"STAFF"'] := IntToStr(AProvider);
224 R := 0;
225 tmp := '';
226 Ans := Answers;
227 repeat
228 tmp := copy(Ans,1,200);
229 delete(Ans,1,200);
230 inc(R);
231 Param[1].Mult['"R' + IntToStr(R) + '"'] := tmp;
232 until(Ans = '');
233 CallBroker;
234 AText := '';
235 for i := 0 to Results.Count-1 do
236 begin
237 tmp := Results[i];
238 if(Piece(tmp,U,1) = '7') then
239 begin
240 if(AText <> '') then
241 begin
242 if(copy(AText, length(AText), 1) = '.') then
243 AText := AText + ' ';
244 AText := AText + ' ';
245 end;
246 AText := AText + Trim(Piece(tmp, U, 2));
247 end;
248 end;
249 end;
250end;
251
252procedure SaveMentalHealthTest(const TestName: string; ADate: TFMDateTime;
253 const AProvider: Int64; const Answers: string);
254var
255 R: integer;
256 Ans, tmp: string;
257
258begin
259 with RPCBrokerV do
260 begin
261 ClearParameters := True;
262 RemoteProcedure := 'ORQQPXRM MENTAL HEALTH SAVE';
263 Param[0].PType := list;
264 Param[0].Mult['"DFN"'] := Patient.DFN;
265 Param[0].Mult['"CODE"'] := TestName;
266 Param[0].Mult['"ADATE"'] := FloatToStr(ADate);
267 Param[0].Mult['"STAFF"'] := IntToStr(AProvider);
268 R := 0;
269 tmp := '';
270 Ans := Answers;
271 repeat
272 tmp := copy(Ans,1,200);
273 delete(Ans,1,200);
274 inc(R);
275 Param[0].Mult['"R' + IntToStr(R) + '"'] := tmp;
276 until(Ans = '');
277 CallBroker;
278 end;
279end;
280
281procedure SaveWomenHealthData(var WHData: TStringlist);
282begin
283 if assigned(WHData) then
284 begin
285 CallV('ORQQPXRM WOMEN HEALTH SAVE', [WHData]);
286// if RPCBrokerV.Results<>nil then
287// infoBox(RPCBrokerV.Results.Text,'Error in Saving WH Data',MB_OK);
288 end;
289end;
290
291function CheckGECValue(const RemIEN: string; NoteIEN: integer): String;
292var
293ans,str,str1,title: string;
294fin: boolean;
295i,cnt: integer;
296
297begin
298 Result := sCallV('ORQQPXRM GEC DIALOG', [RemIEN, Patient.DFN, Encounter.VisitStr, NoteIEN]);
299 if Piece(Result,U,1) <> '0' then
300 begin
301 if Piece(Result,U,5)='1' then
302 begin
303 if pos('~',Piece(Result,U,4))>0 then
304 begin
305 str:='';
306 str1 := Piece(Result,U,4);
307 cnt := DelimCount(str1, '~');
308 for i:=1 to cnt+1 do
309 begin
310 if i = 1 then str := Piece(str1,'~',i);
311 if i > 1 then str :=str+CRLF+Piece(str1,'~',i);
312 end;
313 end
314 else str := Piece(Result,U,1);
315 title := Piece(Result,U,3);
316 fin := (InfoBox(str,title, MB_YESNO)=IDYES);
317 if fin = true then ans := '1';
318 if fin = false then ans := '0';
319 CallV('ORQQPXRM GEC FINISHED?',[Patient.DFN,ans]);
320 end;
321 Result := Piece(Result, U,2);
322 end
323 else Result := '';
324end;
325
326procedure SaveMSTDataFromReminder(VDate, Sts, Prov, FType, FIEN, Res: string);
327begin
328 CallV('ORQQPXRM MST UPDATE', [Patient.DFN, VDate, Sts, Prov, FType, FIEN, Res]);
329end;
330
331function GetReminderFolders: string;
332begin
333 Result := sCallV('ORQQPX GET FOLDERS', []);
334end;
335
336procedure SetReminderFolders(const Value: string);
337begin
338 CallV('ORQQPX SET FOLDERS', [Value]);
339end;
340
341function GetDefLocations: TStrings;
342begin
343 if (User.DUZ <> uLastDefLocUser) then
344 begin
345 if(not assigned(uDefLocs)) then
346 uDefLocs := TStringList.Create;
347 tCallV(uDefLocs, 'ORQQPX GET DEF LOCATIONS', []);
348 uLastDefLocUser := User.DUZ;
349 end;
350 Result := uDefLocs;
351end;
352
353function InsertRemTextAtCursor: boolean;
354begin
355 if uRemInsertAtCursor < 0 then
356 begin
357 Result := (sCallV('ORQQPX REM INSERT AT CURSOR', []) = '1');
358 uRemInsertAtCursor := ord(Result);
359 end
360 else
361 Result := Boolean(uRemInsertAtCursor);
362end;
363
364function NewRemCoverSheetListActive: boolean;
365begin
366 if uNewCoverSheetListActive < 0 then
367 begin
368 Result := (sCallV('ORQQPX NEW COVER SHEET ACTIVE', []) = '1');
369 uNewCoverSheetListActive := ord(Result);
370 end
371 else
372 Result := Boolean(uNewCoverSheetListActive);
373end;
374
375function CanEditAllRemCoverSheetLists: boolean;
376begin
377 if uCanEditAllCoverSheetLists < 0 then
378 begin
379 Result := HasMenuOptionAccess('PXRM CPRS CONFIGURATION');
380 uCanEditAllCoverSheetLists := ord(Result);
381 end
382 else
383 Result := Boolean(uCanEditAllCoverSheetLists);
384end;
385
386function GetCoverSheetLevelData(ALevel, AClass: string): TStrings;
387begin
388 CallV('ORQQPX LVREMLST', [ALevel, AClass]);
389 Result := RPCBrokerV.Results;
390end;
391
392procedure SetCoverSheetLevelData(ALevel, AClass: string; Data: TStrings);
393var
394 i: integer;
395
396begin
397 with RPCBrokerV do
398 begin
399 ClearParameters := True;
400 RemoteProcedure := 'ORQQPX SAVELVL';
401 Param[0].PType := literal;
402 Param[0].Value := ALevel;
403 Param[1].PType := literal;
404 Param[1].Value := AClass;
405 Param[2].PType := list;
406 for i := 0 to Data.Count-1 do
407 Param[2].Mult[IntToStr(i+1)] := Data[i];
408 CallBroker;
409 end;
410end;
411
412function GetCategoryItems(CatIEN: integer): TStrings;
413begin
414 CallV('PXRM REMINDER CATEGORY', [CatIEN]);
415 Result := RPCBrokerV.Results;
416end;
417
418function GetAllRemindersAndCategories: TStrings;
419begin
420 CallV('PXRM REMINDERS AND CATEGORIES', []);
421 Result := RPCBrokerV.Results;
422end;
423
424initialization
425
426finalization
427 FreeAndNil(uDefLocs);
428
429end.
Note: See TracBrowser for help on using the repository browser.