source: cprs/trunk/CPRS-Chart/rReminders.pas@ 796

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

Initial Upload of Official WV CPRS 1.0.26.76

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