source: cprs/branches/tmg-cprs/CPRS-Chart/rSurgery.pas@ 1163

//kt -- Modified with SourceScanner on 8/7/2007

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.