iSharkFly-Open
/
VistA-cprs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-cprs/CPRS-Chart/Consults/rConsults.pas

863 lines
31 KiB
Plaintext
Raw Permalink Blame History

unit rConsults;
interface
uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, uConsults, rTIU, uTIU;
type
TUnresolvedConsults = record
UnresolvedConsultsExist: boolean;
ShowNagScreen: boolean;
end;
{Consult Titles }
function DfltConsultTitle: integer;
function DfltConsultTitleName: string;
function DfltClinProcTitle: integer;
function DfltClinProcTitleName: string;
function IdentifyConsultsClass: integer;
function IdentifyClinProcClass: integer;
procedure ListConsultTitlesShort(Dest: TStrings);
procedure ListClinProcTitlesShort(Dest: TStrings);
function SubSetOfConsultTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
function SubSetOfClinProcTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
procedure ResetConsultTitles;
procedure ResetClinProcTitles;
{ Data Retrieval }
procedure GetConsultsList(Dest: TStrings; Early, Late: double;
Service, Status: string; SortAscending: Boolean);
procedure LoadConsultDetail(Dest: TStrings; IEN: integer) ;
function GetCurrentContext: TSelectContext;
procedure SaveCurrentContext(AContext: TSelectContext) ;
procedure DisplayResults(Dest: TStrings; IEN: integer) ;
procedure GetConsultRec(IEN: integer) ;
function ShowSF513(ConsultIEN: integer): TStrings ;
procedure PrintSF513ToDevice(AConsult: Integer; const ADevice: string; ChartCopy: string;
var ErrMsg: string);
function GetFormattedSF513(AConsult: Integer; ChartCopy: string): TStrings;
function UnresolvedConsultsExist: boolean;
procedure GetUnresolvedConsultsInfo;
{list box fillers}
function SubSetOfStatus: TStrings;
function SubSetOfUrgencies(ConsultIEN: integer): TStrings;
function LoadServiceList(Purpose: integer): TStrings ;
function LoadServiceListWithSynonyms(Purpose: integer): TStrings ; overload;
function LoadServiceListWithSynonyms(Purpose, ConsultIEN: integer): TStrings ; overload;
function SubSetOfServices(const StartFrom: string; Direction: Integer): TStrings;
function FindConsult(ConsultIEN: integer): string ;
{user access level functions}
function ConsultServiceUser(ServiceIEN: integer; DUZ: int64): boolean ;
function GetActionMenuLevel(ConsultIEN: integer): TMenuAccessRec ;
{consult result functions}
function GetAssignableMedResults(ConsultIEN: integer): TStrings;
function GetRemovableMedResults(ConsultIEN: integer): TStrings;
function GetDetailedMedicineResults(ResultID: string): TStrings;
procedure AttachMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64; AlertTo: string);
procedure RemoveMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64);
{Consult Request Actions}
procedure ReceiveConsult(Dest: TStrings; IEN: integer; ReceivedBy: int64; RcptDate: TFMDateTime; Comments: TStrings);
procedure ScheduleConsult(Dest: TStrings; IEN: integer; ScheduledBy: Int64; SchdDate: TFMDateTime; Alert: integer;
AlertTo: string; Comments: TStrings);
procedure DiscontinueConsult(Dest: TStrings; IEN: integer; DiscontinuedBy: int64;
DiscontinueDate: TFMDateTime; Comments: TStrings);
procedure DenyConsult(Dest: TStrings; IEN: integer; DeniedBy: int64;
DenialDate: TFMDateTime; Comments: TStrings);
procedure ForwardConsult(Dest: TStrings; IEN, ToService: integer; Forwarder, AttentionOf: int64;
Urgency: integer; ActionDate: TFMDateTime; Comments: TStrings);
procedure AddComment(Dest: TStrings; IEN: integer; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
AlertTo: string) ;
procedure SigFindings(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings; ActionDate: TFMDateTime;Alert: integer;
AlertTo: string) ;
procedure AdminComplete(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings;
RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
{ Consults Ordering Calls }
function ODForConsults: TStrings;
function ODForProcedures: TStrings;
function ConsultMessage(AnIEN: Integer): string;
function LoadConsultsQuickList: TStrings ;
function GetProcedureServices(ProcIEN: integer): TStrings;
function ConsultCanBeResubmitted(ConsultIEN: integer): string;
function LoadConsultForEdit(ConsultIEN: integer): TEditResubmitRec;
function ResubmitConsult(EditResubmitRec: TEditResubmitRec): string;
function SubSetOfProcedures(const StartFrom: string; Direction: Integer): TStrings;
function GetDefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
function ReasonForRequestEditable(Service: string): string;
function GetNewDialog(OrderType: string): string;
function GetServiceIEN(ORIEN: string): string;
function GetProcedureIEN(ORIEN: string): string;
function GetConsultOrderIEN(ConsultIEN: integer): string;
function GetServicePrerequisites(Service: string): TStrings;
procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
function IsProstheticsService(SvcIen: int64) : string;
{ Clinical Procedures Specific}
function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
var
uConsultsClass: integer;
uConsultTitles: TConsultTitles;
uClinProcClass: integer;
uClinProcTitles: TClinProcTitles;
uUnresolvedConsults: TUnresolvedConsults;
implementation
uses rODBase;
var
uLastOrderedIEN: Integer;
uLastOrderMsg: string;
{ -------------------------- Consult Titles --------------------------------- }
function IdentifyConsultsClass: integer;
begin
if uConsultsClass = 0 then
uConsultsClass := StrToIntDef(sCallV('TIU IDENTIFY CONSULTS CLASS',[nil]), 0) ;
Result := uConsultsClass;
end;
procedure LoadConsultTitles;
{ private - called one time to set up the uConsultTitles object }
var
x: string;
begin
if uConsultTitles <> nil then Exit;
CallV('TIU PERSONAL TITLE LIST', [User.DUZ, IdentifyConsultsClass]);
RPCBrokerV.Results.Insert(0, '~SHORT LIST'); // insert so can call ExtractItems
uConsultTitles := TConsultTitles.Create;
ExtractItems(uConsultTitles.ShortList, RPCBrokerV.Results, 'SHORT LIST');
x := ExtractDefault(RPCBrokerV.Results, 'SHORT LIST');
uConsultTitles.DfltTitle := StrToIntDef(Piece(x, U, 1), 0);
uConsultTitles.DfltTitleName := Piece(x, U, 2);
end;
procedure ResetConsultTitles;
begin
if uConsultTitles <> nil then
begin
uConsultTitles.Free;
uConsultTitles := nil;
LoadConsultTitles;
end;
end;
function DfltConsultTitle: integer;
{ returns the user defined default Consult title (if any) }
begin
if uConsultTitles = nil then LoadConsultTitles;
Result := uConsultTitles.DfltTitle;
end;
function DfltConsultTitleName: string;
{ returns the name of the user defined default progress note title (if any) }
begin
if uConsultTitles = nil then LoadConsultTitles;
Result := uConsultTitles.DfltTitleName;
end;
procedure ListConsultTitlesShort(Dest: TStrings);
{ returns the user defined list (short list) of Consult titles }
begin
if uConsultTitles = nil then LoadConsultTitles;
Dest.AddStrings(uConsultTitles.ShortList);
if uConsultTitles.ShortList.Count > 0 then
begin
Dest.Add('0^________________________________________________________________________');
Dest.Add('0^ ');
end;
end;
function SubSetOfConsultTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
{ returns a pointer to a list of consults progress note titles (for use in a long list box) -
The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE
the next broker call! }
begin
(* if IDNoteTitlesOnly then // This RPC not changed for initial ID Notes release
CallV('TIU LONG LIST CONSULT TITLES', [StartFrom, Direction, IDNoteTitlesOnly])
else*)
CallV('TIU LONG LIST CONSULT TITLES', [StartFrom, Direction]);
//MixedCaseList(RPCBrokerV.Results);
Result := RPCBrokerV.Results;
end;
{ -------------------------- Clinical Procedures Titles --------------------------------- }
function IdentifyClinProcClass: integer;
begin
if uClinProcClass = 0 then
uClinProcClass := StrToIntDef(sCallV('TIU IDENTIFY CLINPROC CLASS',[nil]), 0) ;
Result := uClinProcClass;
end;
procedure LoadClinProcTitles;
{ private - called one time to set up the uConsultTitles object }
var
x: string;
begin
if uClinProcTitles <> nil then Exit;
CallV('TIU PERSONAL TITLE LIST', [User.DUZ, IdentifyClinProcClass]);
RPCBrokerV.Results.Insert(0, '~SHORT LIST'); // insert so can call ExtractItems
uClinProcTitles := TClinProcTitles.Create;
ExtractItems(uClinProcTitles.ShortList, RPCBrokerV.Results, 'SHORT LIST');
x := ExtractDefault(RPCBrokerV.Results, 'SHORT LIST');
uClinProcTitles.DfltTitle := StrToIntDef(Piece(x, U, 1), 0);
uClinProcTitles.DfltTitleName := Piece(x, U, 2);
end;
procedure ResetClinProcTitles;
begin
if uClinProcTitles <> nil then
begin
uClinProcTitles.Free;
uClinProcTitles := nil;
LoadClinProcTitles;
end;
end;
function DfltClinProcTitle: integer;
{ returns the user defined default ClinProc title (if any) }
begin
if uClinProcTitles = nil then LoadClinProcTitles;
Result := uClinProcTitles.DfltTitle;
end;
function DfltClinProcTitleName: string;
{ returns the name of the user defined default progress note title (if any) }
begin
if uClinProcTitles = nil then LoadClinProcTitles;
Result := uClinProcTitles.DfltTitleName;
end;
procedure ListClinProcTitlesShort(Dest: TStrings);
{ returns the user defined list (short list) of ClinProc titles }
begin
if uClinProcTitles = nil then LoadClinProcTitles;
Dest.AddStrings(uClinProcTitles.ShortList);
if uClinProcTitles.ShortList.Count > 0 then
begin
Dest.Add('0^________________________________________________________________________');
Dest.Add('0^ ');
end;
end;
function SubSetOfClinProcTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
{ returns a pointer to a list of clinical procedures titles (for use in a long list box) -
The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE
the next broker call! }
begin
(* if IDNoteTitlesOnly then // This RPC not changed for initial ID Notes release
CallV('TIU LONG LIST CLINPROC TITLES', [StartFrom, Direction, IDNoteTitlesOnly])
else*)
CallV('TIU LONG LIST CLINPROC TITLES', [StartFrom, Direction]);
//MixedCaseList(RPCBrokerV.Results);
Result := RPCBrokerV.Results;
end;
{--------------- data retrieval ------------------------------------------}
procedure GetConsultsList(Dest: TStrings; Early, Late: double;
Service, Status: string; SortAscending: Boolean);
{ returns a list of consults for a patient, based on selected dates, service, status, or ALL}
var
i: Integer;
x, date1, date2: string;
begin
if Early <= 0 then date1 := '' else date1 := FloatToStr(Early) ;
if Late <= 0 then date2 := '' else date2 := FloatToStr(Late) ;
CallV('ORQQCN LIST', [Patient.DFN, date1, date2, Service, Status]);
with RPCBrokerV do
begin
if Copy(Results[0],1,1) <> '<' then
begin
SortByPiece(TStringList(Results), U, 2);
if not SortAscending then InvertStringList(TStringList(Results));
//SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 2);
for i := 0 to Results.Count - 1 do
begin
x := MakeConsultListItem(Results[i]);
Results[i] := x;
end;
FastAssign(Results, Dest);
end
else
begin
Dest.Clear ;
Dest.Add('-1^No Matches') ;
end ;
end;
end;
procedure LoadConsultDetail(Dest: TStrings; IEN: integer) ;
{ returns the detail of a consult }
begin
CallV('ORQQCN DETAIL', [IEN]);
FastAssign(RPCBrokerV.Results, Dest);
end;
procedure DisplayResults(Dest: TStrings; IEN: integer) ;
{ returns the results for a consult }
begin
CallV('ORQQCN MED RESULTS', [IEN]);
FastAssign(RPCBrokerV.Results, Dest);
end;
procedure GetConsultRec(IEN: integer);
{returns zero node from file 123, plus a list of all related TIU documents, if any}
const
SHOW_ADDENDA = True;
var
alist: TStrings;
x: string ;
i: integer;
{ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
{ Pieces: EntDt^Pat^OrIFN^PtLoc^ToSvc^From^ReqDt^Typ^Urg^Place^Attn^Sts^LstAct^SndPrv^Rslt^
16 17 18 19 20 21 22
^EntMode^ReqTyp^InOut^SigFnd^TIUPtr^OrdFac^FrgnCslt}
begin
FillChar(ConsultRec, SizeOf(ConsultRec), 0);
CallV('ORQQCN GET CONSULT', [IEN, SHOW_ADDENDA]);
ConsultRec.IEN := IEN ;
alist := TStringList.Create ;
try
FastAssign(RPCBrokerV.Results, aList);
x := alist[0] ;
if Piece(x,u,1) <> '-1' then
with ConsultRec do
begin
EntryDate := MakeFMDateTime(Piece(x, U, 1));
ORFileNumber := StrToIntDef(Piece(x, U, 3),0);
PatientLocation := StrToIntDef(Piece(x, U, 4),0);
OrderingFacility := StrToIntDef(Piece(x, U, 21),0);
ForeignConsultFileNum := StrToIntDef(Piece(x, U, 22),0);
ToService := StrToIntDef(Piece(x, U, 5),0);
From := StrToIntDef(Piece(x, U, 6),0);
RequestDate := MakeFMDateTime(Piece(x, U, 7));
ConsultProcedure := Piece(x, U, 8) ;
Urgency := StrToIntDef(Piece(x, U, 9),0);
PlaceOfConsult := StrToIntDef(Piece(x, U, 10),0);
Attention := StrToInt64Def(Piece(x, U, 11),0);
ORStatus := StrToIntDef(Piece(x, U, 12),0);
LastAction := StrToIntDef(Piece(x, U, 13),0);
SendingProvider := StrToInt64Def(Piece(Piece(x, U, 14),';',1),0);
SendingProviderName := Piece(Piece(x, U, 14),';',2) ;
Result := Piece(x, U, 15) ;
ModeOfEntry := Piece(x, U, 16) ;
RequestType := StrToIntDef(Piece(x, U, 17),0);
InOut := Piece(x, U, 18) ;
Findings := Piece(x, U, 19) ;
TIUResultNarrative := StrToIntDef(Piece(x, U, 20),0);
EarliestDate := StrToFloatDef(Piece(x, U, 98), 0);
//LatestDate := StrToFloatDef(Piece(x, U, 99), 0); //dropped requirement WAT
//ProvDiagnosis := Piece(x, U, 23); NO!!!!! Up to 180 Characters!!!!
alist.delete(0) ;
TIUDocuments := TStringList.Create ;
MedResults := TStringList.Create;
if alist.count > 0 then
begin
SortByPiece(TStringList(alist), U, 3);
for i := 0 to alist.Count - 1 do
if Copy(Piece(Piece(alist[i], U, 1), ';', 2), 1, 4) = 'MCAR' then
MedResults.Add(alist[i])
else
TIUDocuments.Add(alist[i]);
end;
end {ConsultRec}
else
ConsultRec.EntryDate := -1 ;
finally
alist.free ;
end ;
end ;
{---------------- list box fillers -----------------------------------}
function SubSetOfStatus: TStrings;
{ returns a pointer to a list of stati (for use in a list box) }
begin
CallV('ORQQCN STATUS', [nil]);
MixedCaseList(RPCBrokerV.Results);
Result := RPCBrokerV.Results;
end;
function SubSetOfUrgencies(ConsultIEN: integer): TStrings;
{ returns a pointer to a list of urgencies }
begin
CallV('ORQQCN URGENCIES',[ConsultIEN]) ;
MixedCaseList(RPCBrokerV.Results);
Result := RPCBrokerV.Results;
end;
function FindConsult(ConsultIEN: integer): string ;
var
x: string;
begin
x := sCallV('ORQQCN FIND CONSULT',[ConsultIEN]);
Result := MakeConsultListItem(x);
end;
{-----------------consult result functions-----------------------------------}
function GetAssignableMedResults(ConsultIEN: integer): TStrings;
begin
CallV('ORQQCN ASSIGNABLE MED RESULTS', [ConsultIEN]);
Result := RPCBrokerV.Results;
end;
function GetRemovableMedResults(ConsultIEN: integer): TStrings;
begin
CallV('ORQQCN REMOVABLE MED RESULTS', [ConsultIEN]);
Result := RPCBrokerV.Results;
end;
function GetDetailedMedicineResults(ResultID: string): TStrings;
begin
CallV('ORQQCN GET MED RESULT DETAILS', [ResultID]);
Result := RPCBrokerV.Results;
end;
procedure AttachMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64; AlertTo: string);
begin
CallV('ORQQCN ATTACH MED RESULTS', [ConsultIEN, ResultID, DateTime, ResponsiblePerson, AlertTo]);
end;
procedure RemoveMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64);
begin
CallV('ORQQCN REMOVE MED RESULTS', [ConsultIEN, ResultID, DateTime, ResponsiblePerson]);
end;
{-------------- user access level functions ---------------------------------}
function ConsultServiceUser(ServiceIEN: integer; DUZ: int64): boolean ;
var
i: integer ;
begin
Result := False ;
CallV('ORWU GENERIC', ['',1,'^GMR(123.5,'+IntToStr(ServiceIEN)+',123.3,"B")']) ;
for i:=0 to RPCBrokerV.Results.Count-1 do
if StrToInt64(Piece(RPCBrokerV.Results[i],u,2))=DUZ then result := True ;
end ;
function GetActionMenuLevel(ConsultIEN: integer): TMenuAccessRec ;
var
x: string;
begin
x := sCallV('ORQQCN SET ACT MENUS', [ConsultIEN]) ;
Result.UserLevel := StrToIntDef(Piece(x, U, 1), 1);
Result.AllowMedResulting := (Piece(x, U, 4) = '1');
Result.AllowMedDissociate := (Piece(x, U, 5) = '1');
Result.AllowResubmit := (Piece(x, U, 6) = '1') and (Piece(ConsultCanBeResubmitted(ConsultIEN), U, 1) <> '0');
Result.ClinProcFlag := StrToIntDef(Piece(x, U, 7), CP_NOT_CLINPROC);
Result.IsClinicalProcedure := (Result.ClinProcFlag > CP_NOT_CLINPROC);
end ;
{------------------- Consult request actions -------------------------------}
procedure ReceiveConsult(Dest: TStrings; IEN: integer; ReceivedBy: int64; RcptDate: TFMDateTime; Comments: TStrings);
begin
CallV('ORQQCN RECEIVE', [IEN, ReceivedBy, RcptDate, Comments]);
FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
end;
procedure ScheduleConsult(Dest: TStrings; IEN: integer; ScheduledBy: Int64; SchdDate: TFMDateTime; Alert: integer;
AlertTo: string; Comments: TStrings);
begin
CallV('ORQQCN2 SCHEDULE CONSULT', [IEN, ScheduledBy, SchdDate, Alert, AlertTo, Comments]);
FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
end;
procedure DenyConsult(Dest: TStrings; IEN: integer; DeniedBy: int64;
DenialDate: TFMDateTime; Comments: TStrings);
begin
CallV('ORQQCN DISCONTINUE', [IEN, DeniedBy, DenialDate,'DY',Comments]);
FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
end;
procedure DiscontinueConsult(Dest: TStrings; IEN: integer; DiscontinuedBy: int64;
DiscontinueDate: TFMDateTime; Comments: TStrings);
begin
CallV('ORQQCN DISCONTINUE', [IEN, DiscontinuedBy, DiscontinueDate,'DC',Comments]);
FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
end;
procedure ForwardConsult(Dest: TStrings; IEN, ToService: integer; Forwarder, AttentionOf: int64; Urgency: integer;
ActionDate: TFMDateTime; Comments: TStrings);
begin
CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]);
FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
end ;
procedure AddComment(Dest: TStrings; IEN: integer; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
AlertTo: string) ;
begin
CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]);
FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
end ;
procedure AdminComplete(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings;
RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
begin
CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]);
FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
end ;
procedure SigFindings(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
AlertTo: string) ;
begin
CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]);
FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
end ;
//================== Ordering functions ===================================
function ODForConsults: TStrings;
{ Returns init values for consults dialog. The results must be used immediately. }
begin
CallV('ORWDCN32 DEF', ['C']);
Result := RPCBrokerV.Results;
end;
function ODForProcedures: TStrings;
{ Returns init values for procedures dialog. The results must be used immediately. }
begin
CallV('ORWDCN32 DEF', ['P']);
Result := RPCBrokerV.Results;
end;
function SubSetOfProcedures(const StartFrom: string; Direction: Integer): TStrings;
begin
begin
CallV('ORWDCN32 PROCEDURES', [StartFrom, Direction]);
Result := RPCBrokerV.Results;
end;
end;
function LoadServiceList(Purpose: integer): TStrings ;
// Purpose: 0=display all services, 1=forward or order from possible services
begin
Callv('ORQQCN SVCTREE',[Purpose]) ;
MixedCaseList(RPCBrokerV.Results) ;
Result := RPCBrokerV.Results;
end ;
function LoadServiceListWithSynonyms(Purpose: integer): TStrings ;
// Param 1 = Starting service (1=All Services)
// Param 2 = Purpose: 0=display all services, 1=forward or order from possible services
// Param 3 = Show synonyms
begin
Callv('ORQQCN SVC W/SYNONYMS',[1, Purpose, True]) ;
MixedCaseList(RPCBrokerV.Results) ;
Result := RPCBrokerV.Results;
end ;
function LoadServiceListWithSynonyms(Purpose, ConsultIEN: integer): TStrings ;
// Param 1 = Starting service (1=All Services)
// Param 2 = Purpose: 0=display all services, 1=forward or order from possible services
// Param 3 = Show synonyms
// Param 4 = Consult IEN
begin
Callv('ORQQCN SVC W/SYNONYMS',[1, Purpose, True, ConsultIEN]) ;
MixedCaseList(RPCBrokerV.Results) ;
Result := RPCBrokerV.Results;
end ;
function SubSetOfServices(const StartFrom: string; Direction: Integer): TStrings;
// used only on consults order dialog for service long combo box, which needs to include quick orders
begin
CallV('ORQQCN SVCLIST', [StartFrom, Direction]);
Result := RPCBrokerV.Results;
end;
function LoadConsultsQuickList: TStrings ;
begin
Callv('ORWDXQ GETQLST',['CSLT', 'Q']) ;
Result := RPCBrokerV.Results;
end ;
function ShowSF513(ConsultIEN: integer): TStrings ;
var
x: string;
i: integer;
begin
CallV('ORQQCN SHOW SF513',[ConsultIEN]) ;
if RPCBrokerV.Results.Count > 0 then
begin
x := RPCBrokerV.Results[0];
i := Pos('-', x);
x := Copy(x, i, 999);
RPCBrokerV.Results[0] := x;
end;
Result := RPCBrokerV.Results;
end ;
procedure PrintSF513ToDevice(AConsult: Integer; const ADevice: string; ChartCopy: string;
var ErrMsg: string);
{ prints a SF 513 on the selected device }
begin
ErrMsg := sCallV('ORQQCN PRINT SF513', [AConsult, ChartCopy, ADevice]);
// if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
end;
function GetFormattedSF513(AConsult: Integer; ChartCopy: string): TStrings;
begin
CallV('ORQQCN SF513 WINDOWS PRINT',[AConsult, ChartCopy]);
Result := RPCBrokerV.Results;
end;
function UnresolvedConsultsExist: boolean;
begin
Result := (sCallV('ORQQCN UNRESOLVED', [Patient.DFN]) = '1');
end;
procedure GetUnresolvedConsultsInfo;
var
x: string;
begin
x := sCallV('ORQQCN UNRESOLVED', [Patient.DFN]);
with uUnresolvedConsults do
begin
UnresolvedConsultsExist := (Piece(x, U, 1) = '1');
ShowNagScreen := (Piece(x, U, 2) = '1');
end;
end;
function ConsultMessage(AnIEN: Integer): string;
begin
if AnIEN = uLastOrderedIEN then Result := uLastOrderMsg else
begin
Result := sCallV('ORWDCN32 ORDRMSG', [AnIEN]);
uLastOrderedIEN := AnIEN;
uLastOrderMsg := Result;
end;
end;
function GetProcedureIEN(ORIEN: string): string;
begin
Result := sCallV('ORQQCN GET PROC IEN', [ORIEN]);
end;
function GetProcedureServices(ProcIEN: integer): TStrings;
begin
CallV('ORQQCN GET PROC SVCS',[ProcIEN]) ;
Result := RPCBrokerV.Results;
end;
function ConsultCanBeResubmitted(ConsultIEN: integer): string;
begin
Result := sCallV('ORQQCN CANEDIT', [ConsultIEN]);
end;
function LoadConsultForEdit(ConsultIEN: integer): TEditResubmitRec;
var
Dest: TStringList;
EditRec: TEditResubmitRec;
begin
Dest := TStringList.Create;
try
tCallV(Dest, 'ORQQCN LOAD FOR EDIT',[ConsultIEN]) ;
with EditRec do
begin
Changed := False;
IEN := ConsultIEN;
ToService := StrToIntDef(Piece(ExtractDefault(Dest, 'SERVICE'), U, 2), 0);
RequestType := Piece(ExtractDefault(Dest, 'TYPE'), U, 3);
OrderableItem := StrToIntDef(Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 1), 0);
ConsultProc := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 3);
ConsultProcName := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 2);
Urgency := StrToIntDef(Piece(ExtractDefault(Dest, 'URGENCY'), U, 3), 0);
UrgencyName := Piece(ExtractDefault(Dest, 'URGENCY'), U, 2);
EarliestDate := StrToFloatDef(Piece(ExtractDefault(Dest, 'EARLIEST'), U, 2), 0);
//LatestDate := StrToFloatDef(Piece(ExtractDefault(Dest, 'LATEST'), U, 2), 0); //dropped requirement WAT
Place := Piece(ExtractDefault(Dest, 'PLACE'), U, 1);
PlaceName := Piece(ExtractDefault(Dest, 'PLACE'), U, 2);
Attention := StrToInt64Def(Piece(ExtractDefault(Dest, 'ATTENTION'), U, 1), 0);
AttnName := Piece(ExtractDefault(Dest, 'ATTENTION'), U, 2);
InpOutp := Piece(ExtractDefault(Dest, 'CATEGORY'), U, 1);
ProvDiagnosis := Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 1);
ProvDxCode := Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 2);
ProvDxCodeInactive := (Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 3) = '1');
RequestReason := TStringList.Create;
ExtractText(RequestReason, Dest, 'REASON');
LimitStringLength(RequestReason, 74);
DenyComments := TStringList.Create;
ExtractText(DenyComments, Dest, 'DENY COMMENT');
OtherComments := TStringList.Create;
ExtractText(OtherComments, Dest, 'ADDED COMMENT');
NewComments := TStringList.Create;
end;
Result := EditRec;
finally
Dest.Free;
end;
end;
function ResubmitConsult(EditResubmitRec: TEditResubmitRec): string;
var
i: integer;
begin
with RPCBrokerV, EditResubmitRec do
begin
ClearParameters := True;
RemoteProcedure := 'ORQQCN RESUBMIT';
Param[0].PType := literal;
Param[0].Value := IntToStr(IEN);
Param[1].PType := list;
with Param[1] do
begin
if ToService > 0 then
Mult['1'] := 'GMRCSS^' + IntToStr(ToService);
if ConsultProc <> '' then
Mult['2'] := 'GMRCPROC^' + ConsultProc ;
if Urgency > 0 then
Mult['3'] := 'GMRCURG^' + IntToStr(Urgency);
if Length(Place) > 0 then
Mult['4'] := 'GMRCPL^' + Place;
if Attention > 0 then
Mult['5'] := 'GMRCATN^' + IntToStr(Attention)
else if Attention = -1 then
Mult['5'] := 'GMRCATN^' + '@';
if RequestType <> '' then
Mult['6'] := 'GMRCRQT^' + RequestType;
if Length(InpOutP) > 0 then
Mult['7'] := 'GMRCION^' + InpOutp;
if Length(ProvDiagnosis) > 0 then
Mult['8'] := 'GMRCDIAG^' + ProvDiagnosis + U + ProvDxCode;
if RequestReason.Count > 0 then
begin
Mult['9'] := 'GMRCRFQ^20';
for i := 0 to RequestReason.Count - 1 do
Mult['9,' + IntToStr(i+1)] := RequestReason.Strings[i];
end;
if NewComments.Count > 0 then
begin
Mult['10'] := 'COMMENT^';
for i := 0 to NewComments.Count - 1 do
Mult['10,' + IntToStr(i+1)] := NewComments.Strings[i];
end;
if EarliestDate > 0 then
Mult['11'] := 'GMRCERDT^' + FloatToStr(EarliestDate); //wat renamed v28
{if LatestDate > 0 then
Mult['12'] := 'GMRCLATE^' + FloatToStr(LatestDate);} //dropped requirement WAT
end;
CallBroker;
Result := '0';
//Result := Results[0];
end;
end;
function GetCurrentContext: TSelectContext;
var
x: string;
AContext: TSelectContext;
begin
x := sCallV('ORQQCN2 GET CONTEXT', [User.DUZ]) ;
with AContext do
begin
Changed := True;
BeginDate := Piece(x, ';', 1);
EndDate := Piece(x, ';', 2);
Status := Piece(x, ';', 3);
Service := Piece(x, ';', 4);
GroupBy := Piece(x, ';', 5);
Ascending := (Piece(x, ';', 6) = '1');
end;
Result := AContext;
end;
procedure SaveCurrentContext(AContext: TSelectContext) ;
var
x: string;
begin
with AContext do
begin
SetPiece(x, ';', 1, BeginDate);
SetPiece(x, ';', 2, EndDate);
SetPiece(x, ';', 3, Status);
SetPiece(x, ';', 4, Service);
SetPiece(x, ';', 5, GroupBy);
SetPiece(x, ';', 6, BOOLCHAR[Ascending]);
end;
CallV('ORQQCN2 SAVE CONTEXT', [x]);
end;
function GetDefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
begin
CallV('ORQQCN DEFAULT REQUEST REASON',[Service, Patient.DFN, Resolve]) ;
Result := RPCBrokerV.Results;
end;
function ReasonForRequestEditable(Service: string): string;
begin
Result := sCallV('ORQQCN EDIT DEFAULT REASON', [Service]);
end;
function GetServicePrerequisites(Service: string): TStrings;
begin
CallV('ORQQCN2 GET PREREQUISITE',[Service, Patient.DFN]) ;
Result := RPCBrokerV.Results;
end;
function GetNewDialog(OrderType: string): string;
{ get dialog for new consults}
begin
Result := sCallV('ORWDCN32 NEWDLG', [OrderType, Encounter.Location]);
end;
function GetServiceIEN(ORIEN: string): string;
begin
Result := sCallV('ORQQCN GET SERVICE IEN', [ORIEN]);
end;
procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
var
x: string;
begin
x := sCallV('ORQQCN PROVDX', [SvcIEN]);
ProvDx.Reqd := Piece(x, U, 1);
ProvDx.PromptMode := Piece(x, U, 2);
end;
function GetConsultOrderIEN(ConsultIEN: integer): string;
begin
Result := sCallV('ORQQCN GET ORDER NUMBER', [ConsultIEN]);
end;
function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
var
x: string;
AnEditRec: TEditNoteRec;
begin
x := sCallV('ORWTIU GET SAVED CP FIELDS', [NoteIEN]);
with AnEditRec do
begin
Author := StrToInt64Def(Piece(x, U, 1), 0);
Cosigner := StrToInt64Def(Piece(x, U, 2), 0);
ClinProcSummCode := StrToIntDef(Piece(x, U, 3), 0);
ClinProcDateTime := StrToFMDateTime(Piece(x, U, 4));
Title := StrToIntDef(Piece(x, U, 5), 0);
DateTime := StrToFloatDef(Piece(x, U, 6), 0);
end;
Result := AnEditRec;
end;
function IsProstheticsService(SvcIen : int64) : string; //wat v28
begin
Result := sCallV('ORQQCN ISPROSVC', [SvcIen]);
end;
initialization
uLastOrderedIEN := 0;
uLastOrderMsg := '';
uConsultsClass := 0;
uClinProcClass := 0;
finalization
if uConsultTitles <> nil then uConsultTitles.Free;
if uClinProcTitles <> nil then uClinProcTitles.Free;
end.
Reference in New Issue View Git Blame Copy Permalink