366 lines
12 KiB
Plaintext
366 lines
12 KiB
Plaintext
unit rODAllergy;
|
|
|
|
{$O-}
|
|
|
|
interface
|
|
|
|
uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc ;
|
|
|
|
type
|
|
TAllergyRec = record
|
|
Changed: boolean;
|
|
IEN: Integer;
|
|
CausativeAgent: string;
|
|
AllergyType: string;
|
|
NatureOfReaction: string;
|
|
SignsSymptoms: TStringList;
|
|
Originator: int64;
|
|
OriginatorName: string;
|
|
Originated: TFMDateTime;
|
|
Comments: TStringList;
|
|
IDBandMarked: TStringList;
|
|
ChartMarked: TStringList;
|
|
Verifier: int64;
|
|
VerifierName: string;
|
|
Verified: boolean;
|
|
VerifiedDateTime: TFMDateTime;
|
|
EnteredInError: boolean;
|
|
DateEnteredInError: TFMDateTime;
|
|
UserEnteringInError: int64;
|
|
ErrorComments: TStringList;
|
|
Observed_Historical: string;
|
|
Observations: TStringList;
|
|
ReactionDate: TFMDateTime;
|
|
Severity: string;
|
|
NoKnownAllergies: Boolean;
|
|
NewComments: TStringList;
|
|
end;
|
|
|
|
TARTPatchInstalled = record
|
|
PatchInstalled: boolean;
|
|
PatchChecked: boolean;
|
|
end;
|
|
|
|
TGMRASiteParams = record
|
|
MarkIDBandFlag: Boolean;
|
|
OriginatorCommentsRequired: Boolean;
|
|
ErrorCommentsEnabled: Boolean;
|
|
ParamsSet: Boolean;
|
|
end;
|
|
|
|
TARTClinUser = record
|
|
IsClinUser: boolean;
|
|
ReasonFailed: string;
|
|
AccessChecked: boolean;
|
|
end;
|
|
|
|
function SearchForAllergies(StringToMatch: string): TStrings;
|
|
function SubsetofSymptoms(const StartFrom: string; Direction: Integer): TStrings;
|
|
function ODForAllergies: TStrings;
|
|
function GetCWADInfo(const DFN: string): string;
|
|
function SaveAllergy(EditRec: TAllergyRec): string;
|
|
function LoadAllergyForEdit(AllergyIEN: integer): TAllergyRec;
|
|
function SendARTBulletin(AFreeTextEntry: string; AComment: TStringList): string;
|
|
function RPCEnterNKAForPatient: string;
|
|
|
|
// site parameter functions
|
|
function ARTPatchInstalled: boolean;
|
|
function GetSiteParams: TGMRASiteParams;
|
|
function MarkIDBand: boolean;
|
|
function RequireOriginatorComments: boolean;
|
|
function EnableErrorComments: boolean;
|
|
function IsARTClinicalUser(var AMessage: string): boolean;
|
|
|
|
implementation
|
|
|
|
const
|
|
NO_YES: array[Boolean] of string = ('NO', 'YES');
|
|
|
|
var
|
|
uARTPatchInstalled: TARTPatchInstalled;
|
|
uGMRASiteParams: TGMRASiteParams;
|
|
uARTClinUser: TARTClinUser;
|
|
|
|
function ODForAllergies: TStrings;
|
|
begin
|
|
CallV('ORWDAL32 DEF',[nil]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SearchForAllergies(StringToMatch: string): TStrings;
|
|
begin
|
|
CallV('ORWDAL32 ALLERGY MATCH',[StringToMatch]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function SubsetofSymptoms(const StartFrom: string; Direction: Integer): TStrings;
|
|
begin
|
|
Callv('ORWDAL32 SYMPTOMS',[StartFrom, Direction]);
|
|
Result := RPCBrokerV.Results;
|
|
end;
|
|
|
|
function GetCWADInfo(const DFN: string): string;
|
|
begin
|
|
Result := sCallV('ORWPT CWAD',[DFN]);
|
|
end;
|
|
|
|
function LoadAllergyForEdit(AllergyIEN: integer): TAllergyRec;
|
|
var
|
|
Dest: TStringList;
|
|
EditRec: TAllergyRec;
|
|
x: string;
|
|
begin
|
|
Dest := TStringList.Create;
|
|
try
|
|
tCallV(Dest, 'ORWDAL32 LOAD FOR EDIT', [AllergyIEN]) ;
|
|
if Piece(RPCBrokerV.Results[0], U, 1) <> '-1' then
|
|
begin
|
|
with EditRec do
|
|
begin
|
|
Changed := False;
|
|
IEN := AllergyIEN;
|
|
CausativeAgent := ExtractDefault(Dest, 'CAUSATIVE AGENT');
|
|
AllergyType := ExtractDefault(Dest, 'ALLERGY TYPE');
|
|
NatureOfReaction := ExtractDefault(Dest, 'NATURE OF REACTION');
|
|
SignsSymptoms := TStringList.Create;
|
|
ExtractItems(SignsSymptoms, Dest, 'SIGN/SYMPTOMS');
|
|
MixedCaseByPiece(SignsSymptoms, U, 4);
|
|
x := ExtractDefault(Dest, 'ORIGINATOR');
|
|
Originator := StrToInt64Def(Piece(x, U, 1), 0);
|
|
OriginatorName := Piece(x, U, 2);
|
|
Originated := StrToFMDateTime(ExtractDefault(Dest, 'ORIGINATED'));
|
|
Comments := TStringList.Create;
|
|
ExtractText(Comments, Dest, 'COMMENTS');
|
|
IDBandMarked := TStringList.Create;
|
|
ExtractItems(IDBandMarked, Dest, 'ID BAND MARKED');
|
|
ChartMarked := TStringList.Create;
|
|
ExtractItems(ChartMarked, Dest, 'CHART MARKED');
|
|
//x := ExtractDefault(Dest, 'VERIFIER');
|
|
//Verifier := StrToInt64Def(Piece(x, U, 1), 0);
|
|
//VerifierName := Piece(x, U, 2);
|
|
//x := ExtractDefault(Dest, 'VERIFIED');
|
|
//Verified := Piece(x, U, 1) = 'YES';
|
|
//if Verified then
|
|
// VerifiedDateTime := StrToFMDateTime(Piece(x, U, 2));
|
|
x := ExtractDefault(Dest, 'ENTERED IN ERROR');
|
|
EnteredInError := Piece(x, U, 1) = 'YES';
|
|
DateEnteredInError := StrToFloatDef(Piece(x, U, 2), 0);
|
|
UserEnteringInError := StrToInt64Def(Piece(x, U, 3), 0);
|
|
ErrorComments := TStringList.Create;
|
|
Observed_Historical := ExtractDefault(Dest, 'OBS/HIST');
|
|
Observations := TStringList.Create;
|
|
ExtractText(Observations, Dest, 'OBSERVATIONS');
|
|
//ReactionDate := StrToFMDateTime(Piece(ExtractDefault(Dest, 'REACTDT'), U, 3));
|
|
//Severity := Piece(ExtractDefault(Dest, 'SEVERITY'), U, 3);
|
|
NoKnownAllergies := (StrToIntDef(Piece(ExtractDefault(Dest, 'NKA'), U, 3), 0) > 0);
|
|
NewComments := TStringList.Create;
|
|
end;
|
|
end
|
|
else
|
|
EditRec.IEN := -1;
|
|
Result := EditRec;
|
|
finally
|
|
Dest.Free;
|
|
end;
|
|
end;
|
|
|
|
function SaveAllergy(EditRec: TAllergyRec): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
with RPCBrokerV, EditRec do
|
|
begin
|
|
ClearParameters := True;
|
|
RemoteProcedure := 'ORWDAL32 SAVE ALLERGY';
|
|
Param[0].PType := literal;
|
|
Param[0].Value := IntToStr(IEN);
|
|
Param[1].PType := literal;
|
|
Param[1].Value := Patient.DFN;
|
|
Param[2].PType := list;
|
|
with Param[2] do
|
|
begin
|
|
if NoKnownAllergies then
|
|
Mult['"GMRANKA"'] := NO_YES[NoKnownAllergies];
|
|
if CausativeAgent <> '' then
|
|
Mult['"GMRAGNT"'] := CausativeAgent;
|
|
if AllergyType <> '' then
|
|
Mult['"GMRATYPE"'] := AllergyType ;
|
|
if NatureOfReaction <> '' then
|
|
Mult['"GMRANATR"'] := NatureOfReaction ;
|
|
if Originator > 0 then
|
|
Mult['"GMRAORIG"'] := IntToStr(Originator);
|
|
if Originated > 0 then
|
|
Mult['"GMRAORDT"'] := FloatToStr(Originated);
|
|
with SignsSymptoms do if Count > 0 then
|
|
begin
|
|
Mult['"GMRASYMP",0'] := IntToStr(Count);
|
|
for i := 0 to Count - 1 do
|
|
Mult['"GMRASYMP",' + IntToStr(i+1)] := Pieces(Strings[i], U, 1, 5);
|
|
end;
|
|
//if Verified then
|
|
// Mult['"GMRAVER"'] := NO_YES[Verified];
|
|
//if Verifier > 0 then
|
|
// Mult['"GMRAVERF"'] := IntToStr(Verifier);
|
|
//if VerifiedDateTime > 0 then
|
|
// Mult['"GMRAVERD"'] := FloatToStr(VerifiedDateTime);
|
|
if EnteredInError then
|
|
begin
|
|
Mult['"GMRAERR"'] := NO_YES[EnteredInError];
|
|
Mult['"GMRAERRBY"'] := IntToStr(UserEnteringInError);
|
|
Mult['"GMRAERRDT"'] := FloatToStr(DateEnteredInError);
|
|
with ErrorComments do if Count > 0 then
|
|
begin
|
|
Mult['"GMRAERRCMTS",0'] := IntToStr(Count);
|
|
for i := 0 to Count - 1 do
|
|
Mult['"GMRAERRCMTS",' + IntToStr(i+1)] := Strings[i];
|
|
end;
|
|
end ;
|
|
with ChartMarked do if Count > 0 then
|
|
begin
|
|
Mult['"GMRACHT",0'] := IntToStr(Count);
|
|
for i := 0 to Count - 1 do
|
|
Mult['"GMRACHT",' + IntToStr(i+1)] := Strings[i];
|
|
end;
|
|
with IDBandMarked do if Count > 0 then
|
|
begin
|
|
Mult['"GMRAIDBN",0'] := IntToStr(Count);
|
|
for i := 0 to Count - 1 do
|
|
Mult['"GMRAIDBN",' + IntToStr(i+1)] := Strings[i];
|
|
end;
|
|
if Length(Observed_Historical) > 0 then
|
|
Mult['"GMRAOBHX"'] := Observed_Historical;
|
|
if ReactionDate > 0 then
|
|
Mult['"GMRARDT"'] := FloatToStr(ReactionDate);
|
|
if Length(Severity) > 0 then
|
|
Mult['"GMRASEVR"'] := Severity;
|
|
with NewComments do if Count > 0 then
|
|
begin
|
|
Mult['"GMRACMTS",0'] := IntToStr(Count);
|
|
for i := 0 to Count - 1 do
|
|
Mult['"GMRACMTS",' + IntToStr(i+1)] := Strings[i];
|
|
end;
|
|
end;
|
|
CallBroker;
|
|
Result := Results[0];
|
|
end;
|
|
end;
|
|
|
|
function RPCEnterNKAForPatient: string;
|
|
begin
|
|
with RPCBrokerV do
|
|
begin
|
|
ClearParameters := True;
|
|
RemoteProcedure := 'ORWDAL32 SAVE ALLERGY';
|
|
Param[0].PType := literal;
|
|
Param[0].Value := '0';
|
|
Param[1].PType := literal;
|
|
Param[1].Value := Patient.DFN;
|
|
Param[2].PType := list;
|
|
with Param[2] do
|
|
Mult['"GMRANKA"'] := 'YES';
|
|
CallBroker;
|
|
Result := Results[0];
|
|
end;
|
|
end;
|
|
|
|
function SendARTBulletin(AFreeTextEntry: string; AComment: TStringList): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
with RPCBrokerV do
|
|
begin
|
|
ClearParameters := True;
|
|
RemoteProcedure := 'ORWDAL32 SEND BULLETIN';
|
|
Param[0].PType := literal;
|
|
Param[0].Value := User.DUZ;
|
|
Param[1].PType := literal;
|
|
Param[1].Value := Patient.DFN;
|
|
Param[2].PType := literal;
|
|
Param[2].Value := AFreeTextEntry;
|
|
if AComment.Count > 0 then with Param[3] do
|
|
begin
|
|
PType := list;
|
|
for i := 0 to AComment.Count - 1 do
|
|
Mult[IntToStr(Succ(i)) + ',0'] := AComment[i];
|
|
Mult['0'] := '^^' + IntToStr(AComment.Count);
|
|
end;
|
|
CallBroker;
|
|
Result := Results[0];
|
|
end;
|
|
end;
|
|
|
|
// Site parameter functions
|
|
|
|
function ARTPatchInstalled: boolean;
|
|
begin
|
|
with uARTPatchInstalled do
|
|
if not PatchChecked then
|
|
begin
|
|
PatchInstalled := ServerHasPatch('GMRA*4.0*21');
|
|
PatchChecked := True;
|
|
end;
|
|
Result := uARTPatchInstalled.PatchInstalled;
|
|
end;
|
|
|
|
function GetSiteParams: TGMRASiteParams;
|
|
var
|
|
x: string;
|
|
begin
|
|
with uGMRASiteParams do
|
|
if not ParamsSet then
|
|
begin
|
|
x := sCallV('ORWDAL32 SITE PARAMS', [nil]);
|
|
MarkIDBandFlag := (Piece(x, U, 5) <> '0');
|
|
OriginatorCommentsRequired := (Piece(x, U, 4) = '1');
|
|
ErrorCommentsEnabled := (Piece(x, U, 11) = '1');
|
|
ParamsSet := True;
|
|
end;
|
|
Result := uGMRASiteParams;
|
|
end;
|
|
|
|
function MarkIDBand: boolean;
|
|
begin
|
|
Result := GetSiteParams.MarkIDBandFlag;
|
|
end;
|
|
|
|
function RequireOriginatorComments: boolean;
|
|
begin
|
|
Result := GetSiteParams.OriginatorCommentsRequired;
|
|
end;
|
|
|
|
function EnableErrorComments: boolean;
|
|
begin
|
|
Result := GetSiteParams.ErrorCommentsEnabled;
|
|
end;
|
|
|
|
(*function IsARTClinicalUser(var AMessage: string): boolean;
|
|
const
|
|
TX_NO_AUTH = 'You are not authorized to perform this action.' + CRLF +
|
|
'Either the ORES or ORELSE key is required.';
|
|
begin
|
|
Result := (User.UserClass > UC_CLERK); // User has ORES or ORELSE key
|
|
if not Result then AMessage := TX_NO_AUTH else AMessage := '';
|
|
end;*)
|
|
|
|
function IsARTClinicalUser(var AMessage: string): boolean;
|
|
const
|
|
TX_NO_AUTH = 'You are not authorized to perform this action.' + CRLF;
|
|
var
|
|
x: string;
|
|
begin
|
|
with uARTClinUser do
|
|
begin
|
|
if not AccessChecked then
|
|
begin
|
|
x := sCallV('ORWDAL32 CLINUSER',[nil]);
|
|
IsClinUser := (Piece(x, U, 1) = '1');
|
|
if not IsClinUser then ReasonFailed := TX_NO_AUTH + Piece(x, U, 2) else ReasonFailed := '';
|
|
AccessChecked := True;
|
|
end;
|
|
Result := IsClinUser;
|
|
AMessage := ReasonFailed ;
|
|
end;
|
|
end;
|
|
|
|
end.
|