VistA-cprs/CPRS-Chart/rSurgery.pas

unit rSurgery;

interface

uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, uSurgery;

type
  TSurgCaseContext = record
    Changed: Boolean;
    OpProc:  string;
    BeginDate: string;
    FMBeginDate: TFMDateTime;
    EndDate: string;
    FMEndDate: TFMDateTime;
    MaxDocs: integer;
    Status: string;
    GroupBy: string;
    TreeAscending: Boolean;
  end ;

  TShowSurgeryTab = record
    Evaluated: boolean;
    ShowIt:     boolean;
  end;

  TShowOpTop = record
    Evaluated: boolean;
    ShowIt:    integer;
  end;

{Surgery Titles }
function  DfltSurgeryTitle(AClassName: string): integer;
function  DfltSurgeryTitleName(AClassName: string): string;
procedure ListSurgeryTitlesShort(Dest: TStrings; AClassName: string);
function SubSetOfSurgeryTitles(const StartFrom: string; Direction: Integer; AClassName: string): TStrings;
function IsSurgeryTitle(TitleIEN: Integer): Boolean;
procedure ResetSurgeryTitles;

{ Data Retrieval }
procedure GetSurgCaseList(Dest: TStrings; Early, Late: double; Context, Max: integer);
procedure ListSurgeryCases(Dest: TStrings);
procedure GetSingleCaseListItemWithDocs(Dest: TStrings; NoteIEN: integer);
function GetSingleCaseListItemWithoutDocs(NoteIEN: integer): string;
//procedure LoadOpTop(Dest: TStrings; ACaseIEN: integer; IsNonORProc, ShowReport: boolean) ;
procedure LoadSurgReportText(Dest: TStrings; IEN: integer) ;
procedure LoadSurgReportDetail(Dest: TStrings; IEN: integer) ;
function  GetCurrentSurgCaseContext: TSurgCaseContext;
procedure SaveCurrentSurgCaseContext(AContext: TSurgCaseContext) ;
function  GetSurgCaseRefForNote(NoteIEN: integer): string;
//function  ShowOpTopOnSignature(ACaseIEN: integer): integer;
function ShowSurgeryTab: boolean;
function IsNonORProcedure(ACaseIEN: integer): boolean;

implementation

var
  uSurgeryTitles: TSurgeryTitles;
  uShowSurgeryTab: TShowSurgeryTab;
  //uShowOpTop: TShowOpTop;

function ShowSurgeryTab: boolean;
begin
  with uShowSurgeryTab do
    begin
      if not Evaluated then
        begin
          ShowIt := sCallV('ORWSR SHOW SURG TAB', [nil]) = '1';
          Evaluated := True;
        end;
      Result := ShowIt;
    end;
end;
{ -------------------------- Surgery Titles --------------------------------- }

procedure LoadSurgeryTitles(AClassName: string);
{ private - called to set up the uSurgeryTitles object }
var
  SurgeryClass: integer;
  x: string;
begin
  if uSurgeryTitles <> nil then
  begin
    if uSurgeryTitles.Classname = AClassName then exit;
    uSurgeryTitles.Free;
    uSurgeryTitles := nil;
  end;
  // pass in class name to return OR/non-OR class, depending on selected case
  SurgeryClass := StrToInt(sCallV('TIU IDENTIFY SURGERY CLASS',[AClassName]))  ;
  CallV('TIU PERSONAL TITLE LIST', [User.DUZ, SurgeryClass]);
  RPCBrokerV.Results.Insert(0, '~SHORT LIST');  // insert so can call ExtractItems
  uSurgeryTitles := TSurgeryTitles.Create;
  ExtractItems(uSurgeryTitles.ShortList, RPCBrokerV.Results, 'SHORT LIST');
  x := ExtractDefault(RPCBrokerV.Results, 'SHORT LIST');
  uSurgeryTitles.ClassName := AClassName;
  uSurgeryTitles.DfltTitle := StrToIntDef(Piece(x, U, 1), 0);
  uSurgeryTitles.DfltTitleName := Piece(x, U, 2);
end;

procedure ResetSurgeryTitles;
begin
  if uSurgeryTitles <> nil then
    begin
      uSurgeryTitles.Free;
      uSurgeryTitles := nil;
    end;
end;

function DfltSurgeryTitle(AClassName: string): integer;
{ returns the user defined default Surgery title (if any) }
begin
  if AClassName <> uSurgeryTitles.ClassName then LoadSurgeryTitles(AClassName);
  Result := uSurgeryTitles.DfltTitle;
end;

function DfltSurgeryTitleName(AClassName: string): string;
{ returns the name of the user defined default progress note title (if any) }
begin
  if AClassName <> uSurgeryTitles.ClassName then LoadSurgeryTitles(AClassName);
  Result := uSurgeryTitles.DfltTitleName;
end;

procedure ListSurgeryTitlesShort(Dest: TStrings; AClassName: string);
{ returns the user defined list (short list) of Surgery titles }
begin
  if (uSurgeryTitles = nil) or (AClassName <> uSurgeryTitles.ClassName) then LoadSurgeryTitles(AClassName);
  Dest.AddStrings(uSurgeryTitles.ShortList);
  if uSurgeryTitles.ShortList.Count > 0 then
  begin
    Dest.Add('0^________________________________________________________________________');
    Dest.Add('0^ ');
  end;
end;

function SubSetOfSurgeryTitles(const StartFrom: string; Direction: Integer; AClassName: string): TStrings;
{ returns a pointer to a list of Surgery 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
   // pass in class name based on OR/non-OR
   CallV('TIU LONG LIST SURGERY TITLES', [StartFrom, Direction, AClassName]);
  //MixedCaseList(RPCBrokerV.Results);
  Result := RPCBrokerV.Results;
end;

function IsSurgeryTitle(TitleIEN: Integer): Boolean;
begin
  Result := False;
  if not ShowSurgeryTab then exit;
  if TitleIEN <= 0 then Exit;
  Result := sCallV('TIU IS THIS A SURGERY?', [TitleIEN]) = '1';
end;

{--------------- data retrieval ------------------------------------------}

procedure GetSurgCaseList(Dest: TStrings; Early, Late: double; Context, Max: integer);
{ returns a list of surgery cases for a patient, based on selected dates, service, status, or ALL}
(*
CASE #^Operative Procedure^Date/Time of Operation^Surgeon;Surgeon name^^^^^^^^^+^Context*)
var
  date1, date2: string;
begin
  if Early <= 0 then date1 := '' else date1 := FloatToStr(Early) ;
  if Late  <= 0 then date2 := '' else date2 := FloatToStr(Late)  ;
  CallV('ORWSR LIST', [Patient.DFN, date1, date2, Context, Max]);
  with RPCBrokerV do
   begin
    if Results.Count > 0 then
      begin
       SortByPiece(TStringList(Results), U, 2);
       InvertStringList(TStringList(Results));
       Dest.Assign(Results);
     end
    else
     begin
       Dest.Clear ;
       Dest.Add('-1^No Matches') ;
     end ;
  end;
end;

procedure ListSurgeryCases(Dest: TStrings);
{ returns a list of surgery cases for a patient, without documents, for fNoteProps case selection}
//CASE #^Operative Procedure^Date/Time of Operation^Surgeon;Surgeon name)
begin
  CallV('ORWSR CASELIST', [Patient.DFN]);
  with RPCBrokerV do
   begin
    if Results.Count > 0 then
      begin
       SortByPiece(TStringList(Results), U, 3);
       InvertStringList(TStringList(Results));
       SetListFMDateTime('mmm dd,yy hh:nn', TStringList(Results), U, 3);
       Dest.Assign(Results);
     end
    else
     begin
       Dest.Clear ;
       Dest.Add('-1^No Cases Found') ;
     end ;
  end;
end;


procedure LoadSurgReportText(Dest: TStrings; IEN: integer) ;
{ returns the text of a surgery report }
begin
  CallV('TIU GET RECORD TEXT', [IEN]);
  Dest.Assign(RPCBrokerV.Results);
end;

procedure LoadSurgReportDetail(Dest: TStrings; IEN: integer) ;
{ returns the detail of a surgery report }
begin
  CallV('TIU DETAILED DISPLAY', [IEN]);
  Dest.Assign(RPCBrokerV.Results);
end;

(*procedure LoadOpTop(Dest: TStrings; ACaseIEN: integer; IsNonORProc, ShowReport: boolean) ;
{ returns the OpTop for a surgical case }
begin
  if IsNonORProc then
    CallV('ORWSR OPTOP NON-OR', [ACaseIEN, ShowReport])
  else
    CallV('ORWSR OPTOP', [ACaseIEN, ShowReport]);
  with RPCBrokerV do
    begin
      //if Results.Count > 0 then Results.Delete(0);   //This is the value of the ShowOpTopOnSignature site parameter.
      Dest.Assign(Results);
    end;
end;*)

function GetCurrentSurgCaseContext: TSurgCaseContext;
var
  x: string;
  AContext: TSurgCaseContext;
begin
  x := sCallV('ORWSR GET SURG CONTEXT', [User.DUZ]) ;
  with AContext do
    begin
      Changed       := True;
      BeginDate     := Piece(x, ';', 1);
      FMBeginDate   := StrToFMDateTime(BeginDate);
      EndDate       := Piece(x, ';', 2);
      FMEndDate     := StrToFMDateTime(EndDate);
      Status        := Piece(x, ';', 3);
      GroupBy       := Piece(x, ';', 4);
      MaxDocs       := StrToIntDef(Piece(x, ';', 5), 0);
      TreeAscending     := (Piece(x, ';', 6) = '1');
    end;
  Result := AContext;
end ;

procedure SaveCurrentSurgCaseContext(AContext: TSurgCaseContext) ;
var
  x: string;
begin
  with AContext do
    begin
      SetPiece(x, ';', 1, BeginDate);
      SetPiece(x, ';', 2, EndDate);
      SetPiece(x, ';', 3, Status);
      SetPiece(x, ';', 4, GroupBy);
      SetPiece(x, ';', 5, IntToStr(MaxDocs));
      SetPiece(x, ';', 6, BOOLCHAR[TreeAscending]);
    end;
  CallV('ORWSR SAVE SURG CONTEXT', [x]);
end;                                                                                 

function GetSurgCaseRefForNote(NoteIEN: integer): string;
var
  x: string;
begin
  x := sCallV('TIU GET REQUEST', [NoteIEN]);
  if Piece(x, ';', 2) <> 'SRF(' then
    Result := '-1'
  else
    Result := x
end;

procedure GetSingleCaseListItemWithDocs(Dest: TStrings; NoteIEN: integer);
begin
  CallV('ORWSR ONECASE', [NoteIEN]);
  Dest.Assign(RPCBrokerV.Results);
end;

function GetSingleCaseListItemWithoutDocs(NoteIEN: integer): string;
begin
  CallV('ORWSR ONECASE', [NoteIEN]);
  if RPCBrokerV.Results.Count > 0 then Result := RPCBrokerV.Results[0];
end;

(*function  ShowOpTopOnSignature(ACaseIEN: integer): integer;
begin
  with uShowOpTop do
    begin
      if not Evaluated then
        begin
          ShowIt := StrToIntDef(sCallV('ORWSR SHOW OPTOP WHEN SIGNING', [ACaseIEN]), 0);
          Evaluated := True;
        end;
      Result := ShowIt;
    end;
end;*)

function IsNonORProcedure(ACaseIEN: integer): boolean;
begin
  Result := sCallV('ORWSR IS NON-OR PROCEDURE', [ACaseIEN]) = '1';
end;

initialization

finalization
  if uSurgeryTitles <> nil then uSurgeryTitles.Free;

end.