source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/rODLab.pas@ 859

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

unit rODLab;



interface



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



     { Laboratory Ordering Calls }

function  ODForLab(Location: integer; Division: integer = 0): TStrings;

procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;

procedure LoadSamples(LoadList: TStringList) ;

procedure LoadSpecimens(SpecimenList: TStringList) ;

function  SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;

function  CalcStopDate(Text: string): string ;

function  MaxDays(Location, Schedule: integer): integer;

function  IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;

function  ImmediateCollectTimes: TStrings;

function  LabCollectFutureDays(Location: integer; Division: integer = 0): integer;

function  GetDefaultImmCollTime: TFMDateTime;

function  ValidImmCollTime(CollTime: TFMDateTime): string;

function  GetOneCollSamp(LRFSAMP: integer): TStrings;

function  GetOneSpecimen(LRFSPEC: integer): string;

procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);

function  GetLastCollectionTime: string;

procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);

procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);

procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);

function  StatAllowed(PatientID: string): boolean;

procedure GetBloodComponents(Dest: TStrings);



implementation



uses  rODBase

      , DKLang  //kt

      ;

(*    fODBase, rODBase, fODLab;*)



procedure GetBloodComponents(Dest: TStrings);

begin

  tCallV(Dest, 'ORWDXVB COMPORD', []);

end;



function  StatAllowed(PatientID: string): boolean;

begin

  Result := (StrToInt(sCallV('ORWDXVB STATALOW',[PatientID])) > 0);

end;



procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);

begin

  tCallV(Dest, 'ORWDXVB RAW', [PatientID, ATests]);

end;



procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);

begin

  tCallV(Dest, 'ORWDXVB RESULTS', [PatientID, ATests]);

end;



procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);

begin

  tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]);

end;



function ODForLab(Location, Division: integer): TStrings;

{ Returns init values for laboratory dialog.  The results must be used immediately. }

begin

  CallV('ORWDLR32 DEF', [Location,Division]);

  Result := RPCBrokerV.Results;

end;



procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;

begin

    tCallV(LoadData, 'ORWDLR32 LOAD', [LabTestIEN]);

end ;



procedure LoadSamples(LoadList: TStringList) ;

begin

    tCallV(LoadList, 'ORWDLR32 ALLSAMP', [nil]);

end ;



function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;

begin

  Callv('ORWDLR32 ALLSPEC',[StartFrom, Direction]);

  Result := RPCBrokerV.Results;

end ;



procedure LoadSpecimens(SpecimenList: TStringList) ;

begin

  tCallV(SpecimenList, 'ORWDLR32 ABBSPEC', [nil]);

end ;



function CalcStopDate(Text: string): string ;

begin

  Result := sCallV('ORWDLR32 STOP', [Text]);

end ;



function MaxDays(Location, Schedule: integer): integer;

begin

  Result := StrToInt(sCallV('ORWDLR32 MAXDAYS',[Location, Schedule]));

end;



function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;

begin

  Result := (StrToInt(sCallV('ORWDLR32 LAB COLL TIME',[ADateTime,Location])) > 0);

end;



function  LabCollectFutureDays(Location: integer; Division: integer): integer;

begin

  Result := StrToInt(sCallV('ORWDLR33 FUTURE LAB COLLECTS',[Location, Division]));

end;



function  ImmediateCollectTimes: TStrings;

begin

  CallV('ORWDLR32 IMMED COLLECT',[nil]);

  Result := RPCBrokerV.Results;

end;



function  GetDefaultImmCollTime: TFMDateTime;

begin

  CallV('ORWDLR32 IC DEFAULT',[nil]);

  Result := StrToFloat(Piece(RPCBrokerV.Results[0], U, 1));

end;



function  ValidImmCollTime(CollTime: TFMDateTime): string;

begin

  CallV('ORWDLR32 IC VALID',[CollTime]);

  Result := RPCBrokerV.Results[0];

end;



function  GetOneCollSamp(LRFSAMP: integer): TStrings;

begin

  CallV('ORWDLR32 ONE SAMPLE', [LRFSAMP]);

  Result := RPCBrokerV.Results;

end;



function  GetOneSpecimen(LRFSPEC: integer): string;

begin

  Result := sCallV('ORWDLR32 ONE SPECIMEN', [LRFSPEC]);

end;



function  GetLastCollectionTime: string;

begin

  Result := sCallV('ORWDLR33 LASTTIME', [nil]);

end

;

procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);

var

  Prefix: string;

  i: integer;

begin

  CallV('ORWDLR32 GET LAB TIMES', [LabDate, Location]);

  with Dest do

    begin

      Assign(RPCBrokerV.Results);

      if (Count > 0) and (Piece(Strings[0], U, 1) <> '-1') then

        for i := 0 to Count - 1 do

          begin

//          if Strings[i] > '1159' then Prefix := 'PM Collection:  ' else Prefix := 'AM Collection:  ';  <-- original line.  //kt 8/8/2007

            if Strings[i] > '1159' then Prefix := DKLangConstW('rODLab_PM_Collectionx')+'  ' else Prefix := DKLangConstW('rODLab_AM_Collectionx')+'  '; //kt added 8/8/2007

            Strings[i] := Strings[i] + U + Prefix + Copy(Strings[i], 1, 2) + ':' + Copy(Strings[i], 3, 2);

          end;

    end;

end;



end.