source: cprs/branches/tmg-cprs/CPRS-Chart/fClinicWardMeds.pas@ 893

//kt -- Modified with SourceScanner on 7/15/2007
unit fClinicWardMeds;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, fAutoSz, StdCtrls, ExtCtrls, ORCtrls,ORFn, rCore, uCore, oRNet, Math,
  DKLang;

type
  TfrmClinicWardMeds = class(TfrmAutoSz)
    stxtLine3: TStaticText;
    stxtLine2: TStaticText;
    stxtLine1: TStaticText;
    btnClinic: TButton;
    btnWard: TButton;
    procedure btnClinicClick(Sender: TObject);
    procedure btnWardClick(Sender: TObject);

  private
    //kt Begin Mod (change Consts to Vars) 7/15/2007
    LOCATION_CHANGE_1  : string;  //kt
    LOCATION_CHANGE_2  : string;  //kt
    LOCATION_CHANGE_3  : string;  //kt
    PRINT_LOCATION_1   : string;  //kt
    PRINT_LOCATION_2   : string;  //kt
    //kt End Mod -------------------
    { Private declarations }
    procedure StartLocationCheck;
    procedure rpcChangeOrderLocation(pOrderList:TStringList);
    procedure BuildMessage(MsgSw:string);
    function  BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList;
    procedure SetupVars;

  public
    { Public declarations }
    // passes order list and selected locations to rpc to be saved with order.
    procedure ClinicOrWardLocation(pOrderList:TStringList; pEncounterLoc: integer; pEncounterLocName: string; var RetLoc: integer); overload;
    // returns Location selected by user.
    function  ClinicOrWardLocation(pEncounterLoc: integer):integer;overLoad;
    function  rpcIsPatientOnWard(Patient: string): boolean;
    function  SelectPrintLocation(pEncounterLoc:integer):integer;
  end;

var
  frmClinicWardMeds: TfrmClinicWardMeds;
  ALocation,AWardLoc, AClinicLoc : integer;
  ASelectedLoc: integer;
  AName, ASvc, AWardName, AClinicName: string;
  AOrderLocList: TStringList;
  AMsgSw: string;

const
//LOCATION_CHANGE_1 = 'This patient is currently admitted to ward';  <-- original line.  //kt 7/15/2007
//LOCATION_CHANGE_2 = 'These orders are written at clinic';  <-- original line.  //kt 7/15/2007
//LOCATION_CHANGE_3 = 'Where do you want the orders administered?';  <-- original line.  //kt 7/15/2007
   //GE CQ9537  - Message text
//PRINT_LOCATION_1 = 'The patient has been admitted to Ward ';  <-- original line.  //kt 7/15/2007
//PRINT_LOCATION_2 =  'Should the orders be printed using the new location?';  <-- original line.  //kt 7/15/2007
  LOC_PRINT_MSG    = 'P';
  LOC_MSG          = 'L';

implementation

uses fFrame;

{$R *.dfm}

//entry point
 
 
procedure TfrmClinicWardMeds.SetupVars;
//kt Added entire function to replace constant declarations 7/15/2007
begin
  LOCATION_CHANGE_1 := DKLangConstW('fClinicWardMeds_This_patient_is_currently_admitted_to_ward');
  LOCATION_CHANGE_2 := DKLangConstW('fClinicWardMeds_These_orders_are_written_at_clinic');
  LOCATION_CHANGE_3 := DKLangConstW('fClinicWardMeds_Where_do_you_want_the_orders_administered');
  PRINT_LOCATION_1 := DKLangConstW('fClinicWardMeds_The_patient_has_been_admitted_to_Ward');
  PRINT_LOCATION_2 :=  DKLangConstW('fClinicWardMeds_Should_the_orders_be_printed_using_the_new_location'); 
end;
 
function  TfrmClinicWardMeds.ClinicOrWardLocation(pEncounterLoc:integer):integer;
begin
  // Patient's current location
   AClinicLoc  := pEncounterLoc;
   AClinicName := Encounter.LocationName;
   AMsgSw := LOC_MSG;
   StartLocationCheck;
   Result := ASelectedLoc;
   frmClinicWardMeds.Close;
end;

//entry point
procedure TfrmClinicWardMeds.ClinicOrWardLocation(pOrderList:TStringList;pEncounterLoc:integer;pEncounterLocName:string; var RetLoc: integer);
begin
  AClinicLoc        := pEncounterLoc;
  AClinicName       := pEncounterLocName;
  AOrderLocList     := TStringList.create;
  AOrderLocList.Clear;
  AMsgSw := LOC_MSG;
  StartLocationCheck;
  if pOrderList.Count > 0 then
     begin
       rpcChangeOrderLocation(BuildOrderLocList(pOrderList, ASelectedLoc));
       RetLoc := ASelectedLoc
     end;
  if Assigned(AOrderLocList) then FreeAndNil(AOrderLocList);
  frmClinicWardMeds.Close;
end;

// returns button selected by user - ward or clinic.  print location
//entry point  -
function  TfrmClinicWardMeds.SelectPrintLocation(pEncounterLoc:integer):integer;
begin
   AClinicLoc        := pEncounterLoc;
   AMsgSw            := LOC_PRINT_MSG;
   StartLocationCheck;
   Result := ASelectedLoc;
   frmClinicWardMeds.Close;
end;

procedure TfrmClinicWardMeds.StartLocationCheck;
begin

  frmClinicWardMeds := TfrmClinicWardMeds.Create(Application);
 // ResizeFormToFont(TForm(frmClinicWardMeds));
  CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
  AWardLoc := ALocation; //current location
  AWardName := AName; // current location name
  if AMsgSW = LOC_PRINT_MSG then BuildMessage(AMsgSw)
  else
     if (ALocation > 0) and (ALocation <> AClinicLoc) then BuildMessage(AMsgSw); //Location has changed, patient admitted
end;

procedure TfrmClinicWardMeds.btnClinicClick(Sender: TObject);
begin
  inherited;
  ASelectedLoc := AClinicLoc;
  frmClinicWardMeds.Close;
end;

procedure TfrmClinicWardMeds.btnWardClick(Sender: TObject);
begin
  inherited;
   ASelectedLoc := AWardLoc;
   frmClinicWardMeds.Close;
end;

procedure TfrmClinicWardMeds.BuildMessage(MsgSw:string);
var
 ALine1Len, ALine2Len, ALine3Len, ALongLine: integer;
begin
  SetupVars;  //kt added 7/15/2007 to replace constants with vars.
    with frmClinicWardMeds do
    begin
//     btnWard.Caption   := 'Ward';  <-- original line.  //kt 7/15/2007
       btnWard.Caption   := DKLangConstW('fClinicWardMeds_Ward'); //kt added 7/15/2007
//     btnClinic.Caption := 'Clinic';  <-- original line.  //kt 7/15/2007
       btnClinic.Caption := DKLangConstW('fClinicWardMeds_Clinic'); //kt added 7/15/2007
       // message text
       if MsgSw = LOC_MSG then
       begin
          //AClinicName := 'this is my long test clinic Name';
          stxtLine1.Caption := LOCATION_CHANGE_1 + ' :' + AWardName;
          stxtLine2.Caption := LOCATION_CHANGE_2+ ' :' + AClinicName;
          stxtLine3.Caption := LOCATION_CHANGE_3;
       end
       else
          begin
              stxtLine1.Caption := PRINT_LOCATION_1 + ':' + AWardName;
              stxtLine2.Caption := PRINT_LOCATION_2;
              stxtLine3.Caption := '';
          end;
    stxtLine2.Left := stxtLine1.left;
    stxtLine3.Left := stxtLine1.left;
    ALine1Len := TextWidthByFont(frmClinicWardMeds.stxtLine1.Font.Handle, frmClinicWardMeds.stxtLine1.Caption);
    ALine2Len := TextWidthByFont(frmClinicWardMeds.stxtLine2.Font.Handle, frmClinicWardMeds.stxtLine2.Caption);
    ALine3Len := TextWidthByFont(frmClinicWardMeds.stxtLine3.Font.Handle, frmClinicWardMeds.stxtLine3.Caption)+25;
    ALongLine := Max(ALine1Len,ALine2Len);
    ALongLine := Max(ALine3Len,ALongLine);
    frmClinicWardMeds.Width := (ALongLine + frmClinicWardMeds.stxtLine1.Left + 15);
    end;
    frmClinicWardMeds.ShowModal;
    frmClinicWardMeds.Release;

end;

function  TfrmClinicWardMeds.BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList;
var i:integer;
    AOrderLoc: string;
begin
   AOrderLocList.clear;
   for i := 0 to pOrderList.Count -1 do
   begin
      AOrderLoc := Piece(pOrderList.Strings[i],U,1) + U + IntToStr(pLocation);
      AOrderLocList.Add(AOrderLoc);
   end;
   Result := AOrderLocList; //return value
end;

procedure TfrmClinicWardMeds.rpcChangeOrderLocation(pOrderList:TStringList);
begin
// OrderIEN^Location  -- used to alter location if ward is selected.

   CallV('ORWDX CHANGE',[pOrderList, Patient.DFN]); 
end;

function TfrmClinicWardMeds.rpcIsPatientOnWard(Patient: string): boolean;
begin
  result := sCallV('ORWDX1 PATWARD',[Patient]) = '1'; 
end;


end.