source: cprs/trunk/CPRS-Chart/fClinicWardMeds.pas@ 1495

unit fClinicWardMeds;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, fAutoSz, StdCtrls, ExtCtrls, ORCtrls,ORFn, rCore, uCore, oRNet, Math,

  VA508AccessibilityManager;



type

  TfrmClinicWardMeds = class(TfrmAutoSz)

    stxtLine3: TStaticText;

    stxtLine2: TStaticText;

    stxtLine1: TStaticText;

    btnClinic: TButton;

    btnWard: TButton;

    procedure btnClinicClick(Sender: TObject);

    procedure btnWardClick(Sender: TObject);



  private

    { Private declarations }

    procedure StartLocationCheck;

    procedure rpcChangeOrderLocation(pOrderList:TStringList);

    procedure BuildMessage(MsgSw:string);

    function  BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList;



  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';

  LOCATION_CHANGE_2 = 'These orders are written at clinic';

  LOCATION_CHANGE_3 = 'Where do you want the orders administered?';

   //GE CQ9537  - Message text

  PRINT_LOCATION_1 = 'The patient has been admitted to Ward ';

  PRINT_LOCATION_2 =  'Should the orders be printed using the new location?';

  LOC_PRINT_MSG    = 'P';

  LOC_MSG          = 'L';



implementation



uses fFrame;



{$R *.dfm}



//entry point

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

    with frmClinicWardMeds do

    begin

       btnWard.Caption   := 'Ward';

       btnClinic.Caption := 'Clinic';

       // 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^1  -- used to alter location if ward is selected RPC expected third value to determine if

//order is an IMO order. If it is being called from here assumed IMO order.



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

end;



function TfrmClinicWardMeds.rpcIsPatientOnWard(Patient: string): boolean;

begin

  result := sCallV('ORWDX1 PATWARD',[Patient]) = '1';

end;





end.