438 lines
12 KiB
Plaintext
438 lines
12 KiB
Plaintext
unit rReminders;
|
|
|
|
interface
|
|
uses
|
|
Windows,Classes, SysUtils, TRPCB, ORNet, ORFn;
|
|
|
|
procedure GetCurrentReminders;
|
|
procedure GetOtherReminders(Dest: TStrings);
|
|
procedure EvaluateReminders(RemList: TStringList);
|
|
function EvaluateReminder(IEN: string): string;
|
|
procedure GetEducationTopicsForReminder(ReminderID: integer);
|
|
procedure GetEducationSubtopics(TopicID: integer);
|
|
procedure GetReminderWebPages(ReminderID: string);
|
|
function DetailReminder(IEN: Integer): TStrings;
|
|
function ReminderInquiry(IEN: Integer): TStrings;
|
|
function EducationTopicDetail(IEN: Integer): TStrings;
|
|
function GetDialogInfo(IEN: string; RemIEN: boolean): TStrings;
|
|
function GetDialogPrompts(IEN: string; Historical: boolean; FindingType: string): TStrings;
|
|
procedure GetDialogStatus(AList: TStringList);
|
|
function GetRemindersActive: boolean;
|
|
function GetProgressNoteHeader: string;
|
|
function LoadMentalHealthTest(TestName: string): TStrings;
|
|
procedure MentalHealthTestResults(var AText: string; const DlgIEN: integer; const TestName:
|
|
string; const AProvider: Int64; const Answers: string);
|
|
procedure SaveMentalHealthTest(const TestName: string; ADate: TFMDateTime;
|
|
const AProvider: Int64; const Answers: string);
|
|
procedure SaveWomenHealthData(var WHData: TStringlist);
|
|
function CheckGECValue(const RemIEN: string; NoteIEN: integer): String;
|
|
procedure SaveMSTDataFromReminder(VDate, Sts, Prov, FType, FIEN, Res: string);
|
|
|
|
function GetReminderFolders: string;
|
|
procedure SetReminderFolders(const Value: string);
|
|
function GetDefLocations: TStrings;
|
|
function InsertRemTextAtCursor: boolean;
|
|
|
|
function NewRemCoverSheetListActive: boolean;
|
|
function CanEditAllRemCoverSheetLists: boolean;
|
|
function GetCoverSheetLevelData(ALevel, AClass: string): TStrings;
|
|
procedure SetCoverSheetLevelData(ALevel, AClass: string; Data: TStrings);
|
|
function GetCategoryItems(CatIEN: integer): TStrings;
|
|
function GetAllRemindersAndCategories: TStrings;
|
|
function VerifyMentalHealthTestComplete(TestName, Answers: string): String;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
uCore, uReminders, rCore;
|
|
|
|
var
|
|
uLastDefLocUser: int64 = -1;
|
|
uDefLocs: TStringList = nil;
|
|
uRemInsertAtCursor: integer = -1;
|
|
uNewCoverSheetListActive: integer = -1;
|
|
uCanEditAllCoverSheetLists: integer = -1;
|
|
|
|
procedure GetCurrentReminders;
|
|
begin
|
|
CallV('ORQQPXRM REMINDERS UNEVALUATED', [Patient.DFN, Encounter.Location]);
|
|
end;
|
|
|
|
procedure GetOtherReminders(Dest: TStrings);
|
|
begin
|
|
CallV('ORQQPXRM REMINDER CATEGORIES', [Patient.DFN, Encounter.Location]);
|
|
Dest.Assign(RPCBrokerV.Results);
|
|
end;
|
|
|
|
procedure EvaluateReminders(RemList: TStringList);
|
|
var
|
|
i: integer;
|
|
|
|
begin
|
|
with RPCBrokerV do
|
|
begin
|
|
ClearParameters := True;
|
|
RemoteProcedure := 'ORQQPXRM REMINDER EVALUATION';
|
|
Param[0].PType := literal;
|
|
Param[0].Value := Patient.DFN;
|
|
Param[1].PType := list;
|
|
for i := 0 to RemList.Count-1 do
|
|
Param[1].Mult[IntToStr(i+1)] := Piece(RemList[i],U,1);
|
|
CallBroker;
|
|
end;
|
|
end;
|
|
|
|
function EvaluateReminder(IEN: string): string;
|
|
var
|
|
TmpSL: TStringList;
|
|
|
|
begin
|
|
TmpSL := TStringList.Create;
|
|
try
|
|
TmpSL.Add(IEN);
|
|
EvaluateReminders(TmpSL);
|
|
if(RPCBrokerV.Results.Count > 0) then
|
|
Result := RPCBrokerV.Results[0]
|
|
else
|
|
Result := IEN;
|
|
finally
|
|
TmpSL.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure GetEducationTopicsForReminder(ReminderID: integer);
|
|
begin
|
|
CallV('ORQQPXRM EDUCATION SUMMARY', [ReminderID]);
|
|
end;
|
|
|
|
procedure GetEducationSubtopics(TopicID: integer);
|
|
begin
|
|
CallV('ORQQPXRM EDUCATION SUBTOPICS', [TopicID]);
|
|
end;
|
|
|
|
procedure GetReminderWebPages(ReminderID: string);
|
|
begin
|
|
if(User.WebAccess) then
|
|
CallV('ORQQPXRM REMINDER WEB', [ReminderID])
|
|
else
|
|
RPCBrokerV.ClearParameters := True;
|
|
end;
|
|
|
|
function DetailReminder(IEN: Integer): TStrings; // Clinical Maintenance
|
|
begin
|
|
if InteractiveRemindersActive then
|
|
CallV('ORQQPXRM REMINDER DETAIL', [Patient.DFN, IEN])
|
|
else
|
|
CallV('ORQQPX REMINDER DETAIL', [Patient.DFN, IEN]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function ReminderInquiry(IEN: Integer): TStrings;
|
|
begin
|
|
CallV('ORQQPXRM REMINDER INQUIRY', [IEN]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function EducationTopicDetail(IEN: Integer): TStrings;
|
|
begin
|
|
CallV('ORQQPXRM EDUCATION TOPIC', [IEN]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function GetDialogInfo(IEN: string; RemIEN: boolean): TStrings;
|
|
begin
|
|
if RemIEN then
|
|
CallV('ORQQPXRM REMINDER DIALOG', [IEN, Patient.DFN])
|
|
else
|
|
CallV('PXRM REMINDER DIALOG (TIU)', [IEN, Patient.DFN]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function GetDialogPrompts(IEN: string; Historical: boolean; FindingType: string): TStrings;
|
|
begin
|
|
CallV('ORQQPXRM DIALOG PROMPTS', [IEN, Historical, FindingType]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
procedure GetDialogStatus(AList: TStringList);
|
|
var
|
|
i: integer;
|
|
|
|
begin
|
|
if(Alist.Count = 0) then exit;
|
|
with RPCBrokerV do
|
|
begin
|
|
ClearParameters := True;
|
|
RemoteProcedure := 'ORQQPXRM DIALOG ACTIVE';
|
|
Param[0].PType := list;
|
|
for i := 0 to AList.Count-1 do
|
|
Param[0].Mult[AList[i]] := '';
|
|
CallBroker;
|
|
AList.Assign(Results);
|
|
end;
|
|
end;
|
|
|
|
function GetRemindersActive: boolean;
|
|
begin
|
|
CallV('ORQQPX NEW REMINDERS ACTIVE', []);
|
|
Result := ((RPCBrokerV.Results.Count = 1) and (RPCBrokerV.Results[0] = '1'));
|
|
end;
|
|
|
|
function GetProgressNoteHeader: string;
|
|
begin
|
|
Result := sCallV('ORQQPXRM PROGRESS NOTE HEADER', [Encounter.Location]);
|
|
end;
|
|
|
|
function LoadMentalHealthTest(TestName: string): TStrings;
|
|
begin
|
|
CallV('ORQQPXRM MENTAL HEALTH', [TestName]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
procedure MentalHealthTestResults(var AText: string; const DlgIEN: integer; const TestName:
|
|
string; const AProvider: Int64; const Answers: string);
|
|
var
|
|
i, R: integer;
|
|
Ans, tmp: string;
|
|
|
|
begin
|
|
with RPCBrokerV do
|
|
begin
|
|
ClearParameters := True;
|
|
RemoteProcedure := 'ORQQPXRM MENTAL HEALTH RESULTS';
|
|
Param[0].PType := literal;
|
|
Param[0].Value := IntToStr(DlgIEN);
|
|
Param[1].PType := list;
|
|
Param[1].Mult['"DFN"'] := Patient.DFN;
|
|
Param[1].Mult['"CODE"'] := TestName;
|
|
Param[1].Mult['"ADATE"'] := 'T';
|
|
Param[1].Mult['"STAFF"'] := IntToStr(AProvider);
|
|
R := 0;
|
|
tmp := '';
|
|
Ans := Answers;
|
|
repeat
|
|
tmp := copy(Ans,1,200);
|
|
delete(Ans,1,200);
|
|
inc(R);
|
|
Param[1].Mult['"R' + IntToStr(R) + '"'] := tmp;
|
|
until(Ans = '');
|
|
CallBroker;
|
|
AText := '';
|
|
for i := 0 to Results.Count-1 do
|
|
begin
|
|
tmp := Results[i];
|
|
if(Piece(tmp,U,1) = '7') then
|
|
begin
|
|
if(AText <> '') then
|
|
begin
|
|
if(copy(AText, length(AText), 1) = '.') then
|
|
AText := AText + ' ';
|
|
AText := AText + ' ';
|
|
end;
|
|
AText := AText + Trim(Piece(tmp, U, 2));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveMentalHealthTest(const TestName: string; ADate: TFMDateTime;
|
|
const AProvider: Int64; const Answers: string);
|
|
var
|
|
R: integer;
|
|
Ans, tmp: string;
|
|
|
|
begin
|
|
with RPCBrokerV do
|
|
begin
|
|
ClearParameters := True;
|
|
RemoteProcedure := 'ORQQPXRM MENTAL HEALTH SAVE';
|
|
Param[0].PType := list;
|
|
Param[0].Mult['"DFN"'] := Patient.DFN;
|
|
Param[0].Mult['"CODE"'] := TestName;
|
|
Param[0].Mult['"ADATE"'] := FloatToStr(ADate);
|
|
Param[0].Mult['"STAFF"'] := IntToStr(AProvider);
|
|
R := 0;
|
|
tmp := '';
|
|
Ans := Answers;
|
|
repeat
|
|
tmp := copy(Ans,1,200);
|
|
delete(Ans,1,200);
|
|
inc(R);
|
|
Param[0].Mult['"R' + IntToStr(R) + '"'] := tmp;
|
|
until(Ans = '');
|
|
CallBroker;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveWomenHealthData(var WHData: TStringlist);
|
|
begin
|
|
if assigned(WHData) then
|
|
begin
|
|
CallV('ORQQPXRM WOMEN HEALTH SAVE', [WHData]);
|
|
// if RPCBrokerV.Results<>nil then
|
|
// infoBox(RPCBrokerV.Results.Text,'Error in Saving WH Data',MB_OK);
|
|
end;
|
|
end;
|
|
|
|
function CheckGECValue(const RemIEN: string; NoteIEN: integer): String;
|
|
var
|
|
ans,str,str1,title: string;
|
|
fin: boolean;
|
|
i,cnt: integer;
|
|
|
|
begin
|
|
Result := sCallV('ORQQPXRM GEC DIALOG', [RemIEN, Patient.DFN, Encounter.VisitStr, NoteIEN]);
|
|
if Piece(Result,U,1) <> '0' then
|
|
begin
|
|
if Piece(Result,U,5)='1' then
|
|
begin
|
|
if pos('~',Piece(Result,U,4))>0 then
|
|
begin
|
|
str:='';
|
|
str1 := Piece(Result,U,4);
|
|
cnt := DelimCount(str1, '~');
|
|
for i:=1 to cnt+1 do
|
|
begin
|
|
if i = 1 then str := Piece(str1,'~',i);
|
|
if i > 1 then str :=str+CRLF+Piece(str1,'~',i);
|
|
end;
|
|
end
|
|
else str := Piece(Result,U,1);
|
|
title := Piece(Result,U,3);
|
|
fin := (InfoBox(str,title, MB_YESNO)=IDYES);
|
|
if fin = true then ans := '1';
|
|
if fin = false then ans := '0';
|
|
CallV('ORQQPXRM GEC FINISHED?',[Patient.DFN,ans]);
|
|
end;
|
|
Result := Piece(Result, U,2);
|
|
end
|
|
else Result := '';
|
|
end;
|
|
|
|
procedure SaveMSTDataFromReminder(VDate, Sts, Prov, FType, FIEN, Res: string);
|
|
begin
|
|
CallV('ORQQPXRM MST UPDATE', [Patient.DFN, VDate, Sts, Prov, FType, FIEN, Res]);
|
|
end;
|
|
|
|
function GetReminderFolders: string;
|
|
begin
|
|
Result := sCallV('ORQQPX GET FOLDERS', []);
|
|
end;
|
|
|
|
procedure SetReminderFolders(const Value: string);
|
|
begin
|
|
CallV('ORQQPX SET FOLDERS', [Value]);
|
|
end;
|
|
|
|
function GetDefLocations: TStrings;
|
|
begin
|
|
if (User.DUZ <> uLastDefLocUser) then
|
|
begin
|
|
if(not assigned(uDefLocs)) then
|
|
uDefLocs := TStringList.Create;
|
|
tCallV(uDefLocs, 'ORQQPX GET DEF LOCATIONS', []);
|
|
uLastDefLocUser := User.DUZ;
|
|
end;
|
|
Result := uDefLocs;
|
|
end;
|
|
|
|
function InsertRemTextAtCursor: boolean;
|
|
begin
|
|
if uRemInsertAtCursor < 0 then
|
|
begin
|
|
Result := (sCallV('ORQQPX REM INSERT AT CURSOR', []) = '1');
|
|
uRemInsertAtCursor := ord(Result);
|
|
end
|
|
else
|
|
Result := Boolean(uRemInsertAtCursor);
|
|
end;
|
|
|
|
function NewRemCoverSheetListActive: boolean;
|
|
begin
|
|
if uNewCoverSheetListActive < 0 then
|
|
begin
|
|
Result := (sCallV('ORQQPX NEW COVER SHEET ACTIVE', []) = '1');
|
|
uNewCoverSheetListActive := ord(Result);
|
|
end
|
|
else
|
|
Result := Boolean(uNewCoverSheetListActive);
|
|
end;
|
|
|
|
function CanEditAllRemCoverSheetLists: boolean;
|
|
begin
|
|
if uCanEditAllCoverSheetLists < 0 then
|
|
begin
|
|
Result := HasMenuOptionAccess('PXRM CPRS CONFIGURATION');
|
|
uCanEditAllCoverSheetLists := ord(Result);
|
|
end
|
|
else
|
|
Result := Boolean(uCanEditAllCoverSheetLists);
|
|
end;
|
|
|
|
function GetCoverSheetLevelData(ALevel, AClass: string): TStrings;
|
|
begin
|
|
CallV('ORQQPX LVREMLST', [ALevel, AClass]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
procedure SetCoverSheetLevelData(ALevel, AClass: string; Data: TStrings);
|
|
var
|
|
i: integer;
|
|
|
|
begin
|
|
with RPCBrokerV do
|
|
begin
|
|
ClearParameters := True;
|
|
RemoteProcedure := 'ORQQPX SAVELVL';
|
|
Param[0].PType := literal;
|
|
Param[0].Value := ALevel;
|
|
Param[1].PType := literal;
|
|
Param[1].Value := AClass;
|
|
Param[2].PType := list;
|
|
for i := 0 to Data.Count-1 do
|
|
Param[2].Mult[IntToStr(i+1)] := Data[i];
|
|
CallBroker;
|
|
end;
|
|
end;
|
|
|
|
function GetCategoryItems(CatIEN: integer): TStrings;
|
|
begin
|
|
CallV('PXRM REMINDER CATEGORY', [CatIEN]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function GetAllRemindersAndCategories: TStrings;
|
|
begin
|
|
CallV('PXRM REMINDERS AND CATEGORIES', []);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function VerifyMentalHealthTestComplete(TestName, Answers: string): String;
|
|
|
|
begin
|
|
CallV('ORQQPXRM MHV', [Patient.DFN, TestName, Answers]);
|
|
if RPCBrokerV.Results[0]='2' then
|
|
begin
|
|
Result := '2'+ U;
|
|
EXIT;
|
|
end;
|
|
if RPCBrokerV.Results[0] = '1' then
|
|
begin
|
|
Result := '1' + U;
|
|
EXIT;
|
|
end;
|
|
if RPCBrokerV.Results[0] = '0' then
|
|
begin
|
|
Result := '0' + U + RPCBrokerV.Results[1];
|
|
EXIT;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
|
|
finalization
|
|
FreeAndNil(uDefLocs);
|
|
|
|
end.
|