//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.