iSharkFly-Open
/
VistA-cprs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Updating the working copy to CPRS version 28

This commit is contained in:
healthsevak 2015-05-07 16:34:29 +00:00
parent 06e7d38cce
commit 6b3466f900
242 changed files with 91972 additions and 81834 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CPRS-Chart/BA/UBACore.pas
View File

@ -72,7 +72,7 @@ var
implementation implementation
uses fBALocalDiagnoses, fOrdersSign, fReview, rOrders, uCore, rCore, rPCE,uPCE, uses fBALocalDiagnoses, fOrdersSign, fReview, rOrders, uCore, rCore, rPCE,uPCE,
UBAConst, UBAMessages, USignItems; UBAConst, UBAMessages, USignItems, VAUtils;
// ----------------- MAIN CIDC DX HAS BEEN ENTERED LOGIC --------------------------- // ----------------- MAIN CIDC DX HAS BEEN ENTERED LOGIC ---------------------------

3
CPRS-Chart/BA/fBALocalDiagnoses.dfm
View File

@ -9,10 +9,9 @@ inherited frmBALocalDiagnoses: TfrmBALocalDiagnoses
ShowHint = True ShowHint = True
OnActivate = FormActivate OnActivate = FormActivate
OnCreate = FormCreate OnCreate = FormCreate
OnKeyPress = FormKeyPress
OnShow = FormShow OnShow = FormShow
ExplicitWidth = 620 ExplicitWidth = 620
ExplicitHeight = 551 ExplicitHeight = 544
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pnlTop: TPanel [0] object pnlTop: TPanel [0]

24
CPRS-Chart/BA/fBALocalDiagnoses.pas
View File

@ -63,7 +63,6 @@ type
procedure lvDxGridClick(Sender: TObject); procedure lvDxGridClick(Sender: TObject);
procedure lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X, procedure lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer); Y: Integer);
procedure FormKeyPress(Sender: TObject; var Key: Char);
private private
{ Private declarations } { Private declarations }
@ -101,13 +100,11 @@ type
function PersonalListDxFound(pDxCode:string):boolean; function PersonalListDxFound(pDxCode:string):boolean;
procedure ReSetCheckBoxStatus(pDxCode:String); procedure ReSetCheckBoxStatus(pDxCode:String);
procedure DeleteSelectedDx; procedure DeleteSelectedDx;
function IsCtrlDown: boolean;
public public
FLastHintItemNum: integer; FLastHintItemNum: integer;
procedure Enter(theCaller: smallint; pOrderIDList: TStringList); procedure Enter(theCaller: smallint; pOrderIDList: TStringList);
procedure LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string); procedure LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string);
end; end;
const const
@ -174,17 +171,6 @@ begin
ClearAndDisableCBoxes ClearAndDisableCBoxes
end; end;
procedure TfrmBALocalDiagnoses.FormKeyPress(Sender: TObject; var Key: Char);
begin
inherited;
if frmBALocalDiagnoses.IsCtrlDown then
begin
if ( Key = #10 ) then
frmBALocalDiagnoses.buOK.Click;
end;
end;
procedure TfrmBALocalDiagnoses.ListDiagnosisSections(Dest: TStrings); procedure TfrmBALocalDiagnoses.ListDiagnosisSections(Dest: TStrings);
{ return section names in format: ListIndex^SectionName (sections begin with '^') } { return section names in format: ListIndex^SectionName (sections begin with '^') }
var var
@ -1559,16 +1545,6 @@ begin
end; end;
function TfrmBALocalDiagnoses.IsCtrlDown: boolean;
var
State: TKeyboardState;
begin { isCtrlDown }
GetKeyboardState(State);
Result := ((State[VK_CONTROL] and 128)<>0); // Ctrl-button
end; { isCtrlDown }
Initialization Initialization
BADiagnosis := TStringList.Create; BADiagnosis := TStringList.Create;

30
CPRS-Chart/CPRSChart.bdsproj
View File

@ -5,7 +5,7 @@
<Option Name="Personality">Delphi.Personality</Option> <Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType">VCLApplication</Option> <Option Name="ProjectType">VCLApplication</Option>
<Option Name="Version">1.0</Option> <Option Name="Version">1.0</Option>
<Option Name="GUID">{B0A908D8-813B-4A01-B1DE-D0C343E41F8B}</Option> <Option Name="GUID">{D008760C-D3C7-4922-B5CA-7134478BCE35}</Option>
</Option> </Option>
</PersonalityInfo> </PersonalityInfo>
<Delphi.Personality> <Delphi.Personality>
@ -18,7 +18,7 @@
<Compiler> <Compiler>
<Compiler Name="A">8</Compiler> <Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler> <Compiler Name="B">0</Compiler>
<Compiler Name="C">1</Compiler> <Compiler Name="C">0</Compiler>
<Compiler Name="D">1</Compiler> <Compiler Name="D">1</Compiler>
<Compiler Name="E">0</Compiler> <Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler> <Compiler Name="F">0</Compiler>
@ -33,7 +33,7 @@
<Compiler Name="O">1</Compiler> <Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler> <Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler> <Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler> <Compiler Name="R">1</Compiler>
<Compiler Name="S">0</Compiler> <Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler> <Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler> <Compiler Name="U">0</Compiler>
@ -121,11 +121,11 @@
<Linker Name="ExeDescription"></Linker> <Linker Name="ExeDescription"></Linker>
</Linker> </Linker>
<Directories> <Directories>
<Directories Name="OutputDir"></Directories> <Directories Name="OutputDir">C:\Vista\cprs\main\CPRS-Chart</Directories>
<Directories Name="UnitOutputDir">P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\DCU</Directories> <Directories Name="UnitOutputDir">C:\Vista\cprs\main\CPRS-Chart\DCU</Directories>
<Directories Name="PackageDLLOutputDir">P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\Packages</Directories> <Directories Name="PackageDLLOutputDir">C:\Vista\cprs\main\Packages</Directories>
<Directories Name="PackageDCPOutputDir">P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\Packages</Directories> <Directories Name="PackageDCPOutputDir">C:\Vista\cprs\main\Packages</Directories>
<Directories Name="SearchPath">P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-chart;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\WVEHR-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\DCU;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\BDK32\Source</Directories> <Directories Name="SearchPath">..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</Directories>
<Directories Name="Packages">vcl;vclx;dbrtl;Rave65VCL;bdertl;rtl;vcldb;adortl;dbxcds;dbexpress;vclib;ibxpress;xmlrtl;vclactnband;inet;IntrawebDB_80_100;Intraweb_80_100;vclie;inetdbbde;inetdbxpress;IndyCore;IndySystem;dclOfficeXP;VclSmp;soaprtl;dsnap;IndyProtocols;teeui;teedb;tee;vcldbx</Directories> <Directories Name="Packages">vcl;vclx;dbrtl;Rave65VCL;bdertl;rtl;vcldb;adortl;dbxcds;dbexpress;vclib;ibxpress;xmlrtl;vclactnband;inet;IntrawebDB_80_100;Intraweb_80_100;vclie;inetdbbde;inetdbxpress;IndyCore;IndySystem;dclOfficeXP;VclSmp;soaprtl;dsnap;IndyProtocols;teeui;teedb;tee;vcldbx</Directories>
<Directories Name="Conditionals"></Directories> <Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories> <Directories Name="DebugSourceDirs"></Directories>
@ -151,8 +151,8 @@
<VersionInfo Name="AutoIncBuild">False</VersionInfo> <VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo> <VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo> <VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">27</VersionInfo> <VersionInfo Name="Release">28</VersionInfo>
<VersionInfo Name="Build">83</VersionInfo> <VersionInfo Name="Build">24</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo> <VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo> <VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo> <VersionInfo Name="Special">False</VersionInfo>
@ -163,15 +163,15 @@
</VersionInfo> </VersionInfo>
<VersionInfoKeys> <VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">Department of Veterans Affairs</VersionInfoKeys> <VersionInfoKeys Name="CompanyName">Department of Veterans Affairs</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">11/04/2008</VersionInfoKeys> <VersionInfoKeys Name="FileDescription">1/24/2011</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.27.83</VersionInfoKeys> <VersionInfoKeys Name="FileVersion">1.0.28.24</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">1.0.27.83 server required</VersionInfoKeys> <VersionInfoKeys Name="InternalName">1.0.28.24 server required</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">Unauthorized access or misuse of this system and/or its data is a federal crime. Use of all data shall be in accordance with VA policy on security and privacy.</VersionInfoKeys> <VersionInfoKeys Name="LegalCopyright">Unauthorized access or misuse of this system and/or its data is a federal crime. Use of all data shall be in accordance with VA policy on security and privacy.</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">Patch 304</VersionInfoKeys> <VersionInfoKeys Name="OriginalFilename">Patch 280</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">Computerized Patient Record System</VersionInfoKeys> <VersionInfoKeys Name="ProductName">Computerized Patient Record System</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments">Version 1.0.27.83</VersionInfoKeys> <VersionInfoKeys Name="Comments">Version 1.0.28.24</VersionInfoKeys>
</VersionInfoKeys> </VersionInfoKeys>
</Delphi.Personality> </Delphi.Personality>
</BorlandProject> </BorlandProject>

19
CPRS-Chart/CPRSChart.cfg
View File

@ -1,6 +1,6 @@
-$A8 -$A8
-$B- -$B-
-$C+ -$C-
-$D+ -$D+
-$E- -$E-
-$F- -$F-
@ -15,7 +15,7 @@
-$O+ -$O+
-$P+ -$P+
-$Q- -$Q-
-$R- -$R+
-$S- -$S-
-$T- -$T-
-$U- -$U-
@ -32,13 +32,14 @@
-M -M
-$M32768,1048576 -$M32768,1048576
-K$00400000 -K$00400000
-N0"P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\DCU" -E"C:\Vista\cprs\main\CPRS-Chart"
-LE"P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\Packages" -N0"C:\Vista\cprs\main\CPRS-Chart\DCU"
-LN"P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\Packages" -LE"C:\Vista\cprs\main\Packages"
-U"P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-chart;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\WVEHR-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\DCU;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\BDK32\Source" -LN"C:\Vista\cprs\main\Packages"
-O"P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-chart;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\WVEHR-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\DCU;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\BDK32\Source" -U"..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility"
-I"P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-chart;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\WVEHR-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\DCU;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\BDK32\Source" -O"..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility"
-R"P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-chart;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\WVEHR-Lib;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\DCU;P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\BDK32\Source" -I"..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility"
-R"..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility"
-w-UNSAFE_TYPE -w-UNSAFE_TYPE
-w-UNSAFE_CODE -w-UNSAFE_CODE
-w-UNSAFE_CAST -w-UNSAFE_CAST

11
CPRS-Chart/CPRSChart.dpr
View File

@ -7,6 +7,7 @@ program CPRSChart;
uses uses
ShareMem, ShareMem,
Forms, Forms,
WinHelpViewer,
ORSystem, ORSystem,
fPage in 'fPage.pas' {frmPage}, fPage in 'fPage.pas' {frmPage},
fHSplit in 'fHSplit.pas' {frmHSplit}, fHSplit in 'fHSplit.pas' {frmHSplit},
@ -314,7 +315,12 @@ uses
fGraphOthers in 'fGraphOthers.pas' {frmGraphOthers}, fGraphOthers in 'fGraphOthers.pas' {frmGraphOthers},
VA508AccessibilityRouter in '..\VA\VA508Accessibility\VA508AccessibilityRouter.pas', VA508AccessibilityRouter in '..\VA\VA508Accessibility\VA508AccessibilityRouter.pas',
fIVRoutes in 'Orders\fIVRoutes.pas' {frmIVRoutes}, fIVRoutes in 'Orders\fIVRoutes.pas' {frmIVRoutes},
fFindingTemplates in 'Templates\fFindingTemplates.pas' {frmFindingTemplates}; fFindingTemplates in 'Templates\fFindingTemplates.pas' {frmFindingTemplates},
fSpellNotify in 'fSpellNotify.pas' {frmSpellNotify},
uCombatVet in 'uCombatVet.pas',
fCombatVet in 'fCombatVet.pas' {frmCombatVet},
fOCMonograph in 'Orders\fOCMonograph.pas' {frmOCMonograph},
fHunSpell in 'fHunSpell.pas' {frmHunSpell};
{$R *.TLB} {$R *.TLB}
@ -326,6 +332,7 @@ begin
if not BorlandDLLVersionOK then exit; // Exit immediately if old or missing BORLNDMM.DLL if not BorlandDLLVersionOK then exit; // Exit immediately if old or missing BORLNDMM.DLL
RegisterCPRSTypeLibrary; // will halt program if /regserver or /unregserver param RegisterCPRSTypeLibrary; // will halt program if /regserver or /unregserver param
Application.Initialize; Application.Initialize;
frmSplash := nil; frmSplash := nil;
if ParamSearch('SPLASH') <> 'OFF' then if ParamSearch('SPLASH') <> 'OFF' then
begin begin
@ -341,4 +348,4 @@ begin
frmSplash.Free; // close & free splash screen frmSplash.Free; // close & free splash screen
Application.Run; Application.Run;
end; end;
end. end.

103
CPRS-Chart/CPRSChart.dproj
View File

@ -1,6 +1,6 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup> <PropertyGroup>
<ProjectGuid>{b0a908d8-813b-4a01-b1de-d0c343e41f8b}</ProjectGuid> <ProjectGuid>{d008760c-d3c7-4922-b5ca-7134478bce35}</ProjectGuid>
<MainSource>CPRSChart.dpr</MainSource> <MainSource>CPRSChart.dpr</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration> <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform> <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
@ -9,88 +9,51 @@
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' "> <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version> <Version>7.0</Version>
<DCC_AssertionsAtRuntime>False</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>False</DCC_DebugInformation> <DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_WriteableConstants>True</DCC_WriteableConstants> <DCC_WriteableConstants>True</DCC_WriteableConstants>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols> <DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_RangeChecking>True</DCC_RangeChecking>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_MapFile>3</DCC_MapFile> <DCC_MapFile>3</DCC_MapFile>
<DCC_StackSize>32768,1048576</DCC_StackSize> <DCC_StackSize>32768,1048576</DCC_StackSize>
<DCC_ExeOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart</DCC_ExeOutput> <DCC_ExeOutput>C:\Vista\cprs\main\CPRS-Chart</DCC_ExeOutput>
<DCC_DcuOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_DcuOutput> <DCC_DcuOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_DcuOutput>
<DCC_ObjOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_ObjOutput> <DCC_ObjOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_ObjOutput>
<DCC_HppOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_HppOutput> <DCC_HppOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_HppOutput>
<DCC_BplOutput>C:\Vista\cprs\OR_3_243V27\Packages</DCC_BplOutput> <DCC_BplOutput>C:\Vista\cprs\main\Packages</DCC_BplOutput>
<DCC_DcpOutput>C:\Vista\cprs\OR_3_243V27\Packages</DCC_DcpOutput> <DCC_DcpOutput>C:\Vista\cprs\main\Packages</DCC_DcpOutput>
<DCC_UnitSearchPath>C:\Vista\cprs\OR_3_243V27\CPRS-chart;C:\Vista\cprs\OR_3_243V27\CPRS-Lib;C:\Vista\cprs\OR_3_243V27\VA;C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility</DCC_UnitSearchPath> <DCC_UnitSearchPath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_UnitSearchPath>
<DCC_ResourcePath>C:\Vista\cprs\OR_3_243V27\CPRS-chart;C:\Vista\cprs\OR_3_243V27\CPRS-Lib;C:\Vista\cprs\OR_3_243V27\VA;C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility</DCC_ResourcePath> <DCC_ResourcePath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_ResourcePath>
<DCC_ObjPath>C:\Vista\cprs\OR_3_243V27\CPRS-chart;C:\Vista\cprs\OR_3_243V27\CPRS-Lib;C:\Vista\cprs\OR_3_243V27\VA;C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility</DCC_ObjPath> <DCC_ObjPath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_ObjPath>
<DCC_IncludePath>C:\Vista\cprs\OR_3_243V27\CPRS-chart;C:\Vista\cprs\OR_3_243V27\CPRS-Lib;C:\Vista\cprs\OR_3_243V27\VA;C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility</DCC_IncludePath> <DCC_IncludePath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_IncludePath>
<DCC_Define>RELEASE</DCC_Define> <DCC_Define>RELEASE</DCC_Define>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' "> <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version> <Version>7.0</Version>
<DCC_AssertionsAtRuntime>False</DCC_AssertionsAtRuntime>
<DCC_WriteableConstants>True</DCC_WriteableConstants> <DCC_WriteableConstants>True</DCC_WriteableConstants>
<DCC_RangeChecking>True</DCC_RangeChecking>
<DCC_MapFile>3</DCC_MapFile> <DCC_MapFile>3</DCC_MapFile>
<DCC_StackSize>32768,1048576</DCC_StackSize> <DCC_StackSize>32768,1048576</DCC_StackSize>
<DCC_ExeOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart</DCC_ExeOutput> <DCC_DcuOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_DcuOutput>
<DCC_DcuOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_DcuOutput> <DCC_ObjOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_ObjOutput>
<DCC_ObjOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_ObjOutput> <DCC_HppOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_HppOutput>
<DCC_HppOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_HppOutput> <DCC_BplOutput>C:\Vista\cprs\main\Packages</DCC_BplOutput>
<DCC_BplOutput>C:\Vista\cprs\OR_3_243V27\Packages</DCC_BplOutput> <DCC_DcpOutput>C:\Vista\cprs\main\Packages</DCC_DcpOutput>
<DCC_DcpOutput>C:\Vista\cprs\OR_3_243V27\Packages</DCC_DcpOutput> <DCC_UnitSearchPath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_UnitSearchPath>
<DCC_UnitSearchPath>C:\Vista\cprs\OR_3_243V27\CPRS-chart;C:\Vista\cprs\OR_3_243V27\CPRS-Lib;C:\Vista\cprs\OR_3_243V27\VA;C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility</DCC_UnitSearchPath> <DCC_ResourcePath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_ResourcePath>
<DCC_ResourcePath>C:\Vista\cprs\OR_3_243V27\CPRS-chart;C:\Vista\cprs\OR_3_243V27\CPRS-Lib;C:\Vista\cprs\OR_3_243V27\VA;C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility</DCC_ResourcePath> <DCC_ObjPath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_ObjPath>
<DCC_ObjPath>C:\Vista\cprs\OR_3_243V27\CPRS-chart;C:\Vista\cprs\OR_3_243V27\CPRS-Lib;C:\Vista\cprs\OR_3_243V27\VA;C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility</DCC_ObjPath> <DCC_IncludePath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_IncludePath>
<DCC_IncludePath>C:\Vista\cprs\OR_3_243V27\CPRS-chart;C:\Vista\cprs\OR_3_243V27\CPRS-Lib;C:\Vista\cprs\OR_3_243V27\VA;C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility</DCC_IncludePath>
<DCC_Define>DEBUG</DCC_Define> <DCC_Define>DEBUG</DCC_Define>
</PropertyGroup> </PropertyGroup>
<ProjectExtensions> <ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality> <Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType> <Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject> <BorlandProject>
<BorlandProject xmlns=""> <Delphi.Personality> <Parameters> <BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters><Parameters Name="RunParams">CCOW=disable s=192.168.1.11 p=9430</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">28</VersionInfo><VersionInfo Name="Build">24</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1033</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">Department of Veterans Affairs</VersionInfoKeys><VersionInfoKeys Name="FileDescription">1/24/2011</VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.28.24</VersionInfoKeys><VersionInfoKeys Name="InternalName">1.0.28.24 server required</VersionInfoKeys><VersionInfoKeys Name="LegalCopyright">Unauthorized access or misuse of this system and/or its data is a federal crime. Use of all data shall be in accordance with VA policy on security and privacy.</VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename">Patch 280</VersionInfoKeys><VersionInfoKeys Name="ProductName">Computerized Patient Record System</VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments">Version 1.0.28.24</VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">CPRSChart.dpr</Source></Source><TypeLibOptions><TypeLibOptions Name="AutoRegisterTLB">False</TypeLibOptions><TypeLibOptions Name="AutoGenImportAssembly">False</TypeLibOptions></TypeLibOptions></Delphi.Personality></BorlandProject></BorlandProject>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">27</VersionInfo>
<VersionInfo Name="Build">77</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1033</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">Department of Veterans Affairs</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">6/26/2007</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.27.77</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">1.0.27.77 server required</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">Unauthorized access or misuse of this system and/or its data is a federal crime. Use of all data shall be in accordance with VA policy on security and privacy.</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">Patch 243</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">Computerized Patient Record System</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments">Version 1.0.27.77</VersionInfoKeys>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="C:\Vista\cprs\ShiftChangeHandOff\ORCtrlLib60.bpl">CPRS Custom Controls</Excluded_Packages>
</Excluded_Packages>
<Source>
<Source Name="MainSource">CPRSChart.dpr</Source>
</Source>
</Delphi.Personality> </BorlandProject></BorlandProject>
</ProjectExtensions> </ProjectExtensions>
<ItemGroup /> <Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup> <ItemGroup>
<DelphiCompile Include="CPRSChart.dpr"> <DelphiCompile Include="CPRSChart.dpr">
<MainSource>MainSource</MainSource> <MainSource>MainSource</MainSource>
@ -276,6 +239,9 @@
<DCCReference Include="fClinicWardMeds.pas"> <DCCReference Include="fClinicWardMeds.pas">
<Form>frmClinicWardMeds</Form> <Form>frmClinicWardMeds</Form>
</DCCReference> </DCCReference>
<DCCReference Include="fCombatVet.pas">
<Form>frmCombatVet</Form>
</DCCReference>
<DCCReference Include="fCover.pas"> <DCCReference Include="fCover.pas">
<Form>frmCover</Form> <Form>frmCover</Form>
</DCCReference> </DCCReference>
@ -330,6 +296,9 @@
<DCCReference Include="fHSplit.pas"> <DCCReference Include="fHSplit.pas">
<Form>frmHSplit</Form> <Form>frmHSplit</Form>
</DCCReference> </DCCReference>
<DCCReference Include="fHunSpell.pas">
<Form>frmHunSpell</Form>
</DCCReference>
<DCCReference Include="fIconLegend.pas"> <DCCReference Include="fIconLegend.pas">
<Form>frmIconLegend</Form> <Form>frmIconLegend</Form>
</DCCReference> </DCCReference>
@ -498,6 +467,9 @@
<DCCReference Include="fSignItem.pas"> <DCCReference Include="fSignItem.pas">
<Form>frmSignItem</Form> <Form>frmSignItem</Form>
</DCCReference> </DCCReference>
<DCCReference Include="fSpellNotify.pas">
<Form>frmSpellNotify</Form>
</DCCReference>
<DCCReference Include="fSplash.pas"> <DCCReference Include="fSplash.pas">
<Form>frmSplash</Form> <Form>frmSplash</Form>
</DCCReference> </DCCReference>
@ -599,6 +571,9 @@
<DCCReference Include="Orders\fOCAccept.pas"> <DCCReference Include="Orders\fOCAccept.pas">
<Form>frmOCAccept</Form> <Form>frmOCAccept</Form>
</DCCReference> </DCCReference>
<DCCReference Include="Orders\fOCMonograph.pas">
<Form>frmOCMonograph</Form>
</DCCReference>
<DCCReference Include="Orders\fOCSession.pas"> <DCCReference Include="Orders\fOCSession.pas">
<Form>frmOCSession</Form> <Form>frmOCSession</Form>
</DCCReference> </DCCReference>
@ -847,6 +822,7 @@
<DCCReference Include="Templates\uTemplateFields.pas" /> <DCCReference Include="Templates\uTemplateFields.pas" />
<DCCReference Include="Templates\uTemplates.pas" /> <DCCReference Include="Templates\uTemplates.pas" />
<DCCReference Include="uCaseTree.pas" /> <DCCReference Include="uCaseTree.pas" />
<DCCReference Include="uCombatVet.pas" />
<DCCReference Include="uConst.pas" /> <DCCReference Include="uConst.pas" />
<DCCReference Include="uCore.pas" /> <DCCReference Include="uCore.pas" />
<DCCReference Include="uDCSumm.pas" /> <DCCReference Include="uDCSumm.pas" />
@ -873,5 +849,4 @@
<DCCReference Include="Vitals\uVitals.pas" /> <DCCReference Include="Vitals\uVitals.pas" />
<DCCReference Include="XuDigSigSC_TLB.pas" /> <DCCReference Include="XuDigSigSC_TLB.pas" />
</ItemGroup> </ItemGroup>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
</Project> </Project>

1154
CPRS-Chart/CPRSChart.drc
View File

File diff suppressed because it is too large Load Diff

410
CPRS-Chart/CPRSChart.dsk
View File

@ -1,41 +1,77 @@
[Closed Files] [Closed Files]
File_0=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\fFrame.pas',0,1,3475,6,3476,0,0,, File_0=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fAllgyBox.pas',0,1,102,1,1,0,0,,
File_1=TSourceModule,'C:\Program Files\vista\BDK32\Source\wsockc.pas',0,1,1464,1,1485,0,0,, File_1=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\Orders\fODGen.pas',0,1,497,39,511,0,0,,
File_2=TSourceModule,'C:\Vista\cprs\OR_3_243V27\VA\VAUtils.pas',0,1,1390,1,1407,0,0,, File_2=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fFrame.pas',0,1,37,1,1,0,0,,
File_3=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\fReports.pas',0,1,245,1,266,0,0,, File_3=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fGraphData.pas',0,1,606,1,1,0,0,,
File_4=TSourceModule,'C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility\VA508AccessibilityManager.pas',0,1,1163,1,1184,0,0,, File_4=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fNotes.pas',0,1,2877,14,2880,0,0,,
File_5=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\uGraphs.pas',0,1,199,1,220,0,0,, File_5=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\Templates\fTemplateFieldEditor.pas',0,1,28,30,46,0,0,,
File_6=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\VERGENCECONTEXTORLib_TLB.pas',0,1,1104,47,1117,0,0,, File_6=TSourceModule,'C:\Vista\cprs\main\CPRS-Lib\ORNet.pas',0,1,1,25,2,0,0,,
File_7=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\Orders\fOrdersDC.pas',0,1,98,51,121,0,0,, File_7=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\uSpell.pas',0,1,7,26,12,0,0,,
File_8=TSourceModule,'c:\program files\borland\bds\4.0\source\Win32\rtl\common\ComObj.pas',0,1,1249,1,1270,0,0,, File_8=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fARTAllgy.pas',0,1,7,3,7,0,0,,
File_9=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fAutoSz.pas',0,1,1,1,1,0,0,,
[Modules] [Modules]
Module0=default.htm Module0=C:\Vista\cprs\main\CPRS-Chart\CPRSChart.bdsproj
Count=1 Module1=C:\Program Files\vista\BDK32_P50T4\Source\Xwbut1.pas
Module2=C:\Vista\cprs\main\CPRS-Lib\ORCtrls.pas
Module3=C:\Vista\cprs\main\VA\VAClasses.pas
Module4=C:\Vista\cprs\main\CPRS-Chart\fNoteBD.pas
Module5=default.htm
Count=6
EditWindowCount=1 EditWindowCount=1
TypeLibWindowCount=1 TypeLibWindowCount=1
[C:\Vista\cprs\main\CPRS-Chart\CPRSChart.bdsproj]
ModuleType=TBaseProject
[C:\Program Files\vista\BDK32_P50T4\Source\Xwbut1.pas]
ModuleType=TSourceModule
FormState=0
FormOnTop=0
[C:\Vista\cprs\main\CPRS-Lib\ORCtrls.pas]
ModuleType=TSourceModule
FormState=0
FormOnTop=0
[C:\Vista\cprs\main\VA\VAClasses.pas]
ModuleType=TSourceModule
FormState=0
FormOnTop=0
[C:\Vista\cprs\main\CPRS-Chart\fNoteBD.pas]
ModuleType=TSourceModule
FormState=0
FormOnTop=0
[default.htm] [default.htm]
ModuleType=TURLModule ModuleType=TURLModule
[C:\Vista\cprs\main\CPRS-Chart\fBase508Form.pas]
FormState=0
FormOnTop=0
[EditWindow0] [EditWindow0]
ViewCount=1 ViewCount=6
CurrentView=0 CurrentEditView=C:\Vista\cprs\main\CPRS-Chart\CPRSChart.dpr
View0=0 View0=0
View1=1
View2=2
View3=3
View4=4
View5=5
PercentageSizes=1 PercentageSizes=1
Create=1 Create=1
Visible=1 Visible=1
Docked=0 Docked=0
State=0 State=0
Left=3154 Left=1709
Top=1192 Top=1131
Width=6797 Width=6797
Height=8767 Height=8760
MaxLeft=0 MaxLeft=0
MaxTop=0 MaxTop=0
ClientWidth=6719 ClientWidth=6719
ClientHeight=8306 ClientHeight=8297
DockedToMainForm=0 DockedToMainForm=0
MessageView=MessageView@EditWindow0 MessageView=MessageView@EditWindow0
BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0
@ -44,19 +80,74 @@ LeftPanelSize=0
LeftPanelClients=BorlandEditorCodeExplorer@EditWindow0 LeftPanelClients=BorlandEditorCodeExplorer@EditWindow0
LeftPanelData=0000080001000100000019000000426F726C616E64456469746F72436F64654578706C6F726572B70C00000000000000E201000000000000FFFFFFFF LeftPanelData=0000080001000100000019000000426F726C616E64456469746F72436F64654578706C6F726572B70C00000000000000E201000000000000FFFFFFFF
RightPanelSize=0 RightPanelSize=0
BottomPanelSize=0 BottomPanelSize=3125
BottomPanelClients=MessageView@EditWindow0 BottomPanelClients=MessageView@EditWindow0
BottomPanelData=000008000100010000000B0000004D657373616765566965770000000000000000000000000000000000FFFFFFFF BottomPanelData=0000080001000000000000000000000000000000000000000000000100000000000000000B0000004D65737361676556696577FFFFFFFF
BottomMiddlePanelSize=0 BottomMiddlePanelSize=0
BottomMiddlePanelClients=DockSite1 BottomMiddlePanelClients=DockSite0
BottomMiddelPanelData=0000080001000100000009000000446F636B53697465310000000000000000000000000000000000FFFFFFFF BottomMiddelPanelData=0000080001000100000009000000446F636B53697465300000000000000000000000000000000000FFFFFFFF
[View0] [View0]
CustomEditViewType=TWelcomePageView CustomEditViewType=TWelcomePageView
WelcomePageURL=bds:/default.htm WelcomePageURL=bds:/default.htm
[View1]
CustomEditViewType=TEditView
Module=C:\Vista\cprs\main\CPRS-Chart\CPRSChart.dpr
CursorX=6
CursorY=328
TopLine=314
LeftCol=1
Elisions=
Bookmarks=
EditViewName=C:\Vista\cprs\main\CPRS-Chart\CPRSChart.dpr
[View2]
CustomEditViewType=TEditView
Module=C:\Vista\cprs\main\CPRS-Chart\fNoteBD.pas
CursorX=1
CursorY=1
TopLine=1
LeftCol=1
Elisions=
Bookmarks=
EditViewName=C:\Vista\cprs\main\CPRS-Chart\fNoteBD.pas
[View3]
CustomEditViewType=TEditView
Module=C:\Vista\cprs\main\VA\VAClasses.pas
CursorX=1
CursorY=314
TopLine=249
LeftCol=1
Elisions=
Bookmarks=
EditViewName=C:\Vista\cprs\main\VA\VAClasses.pas
[View4]
CustomEditViewType=TEditView
Module=C:\Vista\cprs\main\CPRS-Lib\ORCtrls.pas
CursorX=23
CursorY=7235
TopLine=7222
LeftCol=1
Elisions=
Bookmarks=
EditViewName=C:\Vista\cprs\main\CPRS-Lib\ORCtrls.pas
[View5]
CustomEditViewType=TEditView
Module=C:\Program Files\vista\BDK32_P50T4\Source\Xwbut1.pas
CursorX=1
CursorY=319
TopLine=305
LeftCol=1
Elisions=
Bookmarks=
EditViewName=C:\Program Files\vista\BDK32_P50T4\Source\Xwbut1.pas
[TypeLibEditWindow0] [TypeLibEditWindow0]
Module=P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-chart\CPRSChart.tlb Module=C:\Vista\cprs\main\CPRS-Chart\CPRSChart.tlb
[Watches] [Watches]
Count=0 Count=0
@ -70,13 +161,13 @@ Visible=0
Docked=0 Docked=0
State=0 State=0
Left=1738 Left=1738
Top=1423 Top=1417
Width=2627 Width=2627
Height=2344 Height=2343
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=2549 ClientWidth=2549
ClientHeight=1992 ClientHeight=1989
TBDockHeight=163 TBDockHeight=163
LRDockWidth=2549 LRDockWidth=2549
Dockable=1 Dockable=1
@ -84,7 +175,7 @@ StayOnTop=0
[Breakpoints] [Breakpoints]
Count=1 Count=1
Breakpoint0='C:\Vista\cprs\OR_3_243V27\CPRS-chart\fGraphs.pas',462,'',0,1,'',1,0,0,'',1,'','','',0 Breakpoint0='C:\Vista\cprs\main\CPRS-Chart\Orders\fODGen.pas',513,'',0,1,'',1,0,0,'',1,'','','',0
[AddressBreakpoints] [AddressBreakpoints]
Count=0 Count=0
@ -98,11 +189,11 @@ State=0
Left=0 Left=0
Top=0 Top=0
Width=10000 Width=10000
Height=1165 Height=1172
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=9922 ClientWidth=9922
ClientHeight=705 ClientHeight=708
BottomPanelSize=0 BottomPanelSize=0
[ProjectManager] [ProjectManager]
@ -114,12 +205,12 @@ State=0
Left=0 Left=0
Top=0 Top=0
Width=1289 Width=1289
Height=2358 Height=2357
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=1289 ClientWidth=1289
ClientHeight=2358 ClientHeight=2357
TBDockHeight=271 TBDockHeight=272
LRDockWidth=3730 LRDockWidth=3730
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -128,17 +219,17 @@ StayOnTop=0
PercentageSizes=1 PercentageSizes=1
Create=1 Create=1
Visible=1 Visible=1
Docked=1 Docked=0
State=0 State=0
Left=0 Left=8506
Top=0 Top=4292
Width=2920 Width=1475
Height=7696 Height=5613
MaxLeft=-1 MaxLeft=-10
MaxTop=-1 MaxTop=-14
ClientWidth=2920 ClientWidth=1396
ClientHeight=7696 ClientHeight=5259
TBDockHeight=5813 TBDockHeight=5817
LRDockWidth=1406 LRDockWidth=1406
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -150,14 +241,14 @@ Visible=0
Docked=0 Docked=0
State=0 State=0
Left=68 Left=68
Top=8198 Top=8202
Width=3623 Width=3623
Height=3360 Height=3365
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=3545 ClientWidth=3545
ClientHeight=3008 ClientHeight=3011
TBDockHeight=298 TBDockHeight=300
LRDockWidth=3623 LRDockWidth=3623
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -169,14 +260,14 @@ Visible=0
Docked=0 Docked=0
State=0 State=0
Left=68 Left=68
Top=8198 Top=8202
Width=5420 Width=5420
Height=1762 Height=1757
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=5342 ClientWidth=5342
ClientHeight=1409 ClientHeight=1403
TBDockHeight=149 TBDockHeight=150
LRDockWidth=5420 LRDockWidth=5420
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -192,14 +283,14 @@ Visible=0
Docked=0 Docked=0
State=0 State=0
Left=1738 Left=1738
Top=1423 Top=1417
Width=2627 Width=2627
Height=2412 Height=2411
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=2549 ClientWidth=2549
ClientHeight=2060 ClientHeight=2057
TBDockHeight=203 TBDockHeight=204
LRDockWidth=2549 LRDockWidth=2549
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -211,13 +302,13 @@ Visible=0
Docked=0 Docked=0
State=0 State=0
Left=117 Left=117
Top=1558 Top=1553
Width=2627 Width=2627
Height=2344 Height=2343
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=2549 ClientWidth=2549
ClientHeight=1992 ClientHeight=1989
TBDockHeight=163 TBDockHeight=163
LRDockWidth=2549 LRDockWidth=2549
Dockable=1 Dockable=1
@ -232,12 +323,12 @@ State=0
Left=0 Left=0
Top=0 Top=0
Width=4307 Width=4307
Height=1396 Height=1390
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=4307 ClientWidth=4307
ClientHeight=1396 ClientHeight=1390
TBDockHeight=5081 TBDockHeight=5082
LRDockWidth=5303 LRDockWidth=5303
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -251,12 +342,12 @@ State=0
Left=0 Left=0
Top=0 Top=0
Width=4307 Width=4307
Height=1396 Height=1390
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=4307 ClientWidth=4307
ClientHeight=1396 ClientHeight=1390
TBDockHeight=3835 TBDockHeight=3828
LRDockWidth=5303 LRDockWidth=5303
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -270,12 +361,12 @@ State=0
Left=0 Left=0
Top=0 Top=0
Width=4297 Width=4297
Height=5827 Height=5858
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=4219 ClientWidth=4219
ClientHeight=5474 ClientHeight=5504
TBDockHeight=5827 TBDockHeight=5858
LRDockWidth=4297 LRDockWidth=4297
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -292,31 +383,51 @@ State=0
Left=0 Left=0
Top=0 Top=0
Width=1289 Width=1289
Height=2358 Height=2357
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=1289 ClientWidth=1289
ClientHeight=2358 ClientHeight=2357
TBDockHeight=4878 TBDockHeight=4877
LRDockWidth=7148 LRDockWidth=7148
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
[PropertyInspector]
PercentageSizes=1
Create=1
Visible=1
Docked=0
State=0
Left=0
Top=4687
Width=1689
Height=5204
MaxLeft=-10
MaxTop=-14
ClientWidth=1611
ClientHeight=4850
TBDockHeight=5817
LRDockWidth=1543
Dockable=1
StayOnTop=0
SplitPos=73
[MetricsView] [MetricsView]
PercentageSizes=1 PercentageSizes=1
Create=1 Create=1
Visible=0 Visible=0
Docked=1 Docked=1
State=0 State=0
Left=-183 Left=-541
Top=-748 Top=-1945
Width=5303 Width=5303
Height=3835 Height=3828
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=5303 ClientWidth=5303
ClientHeight=3835 ClientHeight=3828
TBDockHeight=3835 TBDockHeight=3828
LRDockWidth=5303 LRDockWidth=5303
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -327,15 +438,15 @@ Create=1
Visible=0 Visible=0
Docked=1 Docked=1
State=0 State=0
Left=-183 Left=-541
Top=-748 Top=-1945
Width=5303 Width=5303
Height=3835 Height=3828
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=5303 ClientWidth=5303
ClientHeight=3835 ClientHeight=3828
TBDockHeight=3835 TBDockHeight=3828
LRDockWidth=5303 LRDockWidth=5303
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -346,15 +457,15 @@ Create=1
Visible=0 Visible=0
Docked=1 Docked=1
State=0 State=0
Left=-183 Left=-541
Top=-748 Top=-1945
Width=5303 Width=5303
Height=3835 Height=3828
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=5303 ClientWidth=5303
ClientHeight=3835 ClientHeight=3828
TBDockHeight=3835 TBDockHeight=3828
LRDockWidth=5303 LRDockWidth=5303
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -365,15 +476,15 @@ Create=1
Visible=0 Visible=0
Docked=1 Docked=1
State=0 State=0
Left=-183 Left=-541
Top=-748 Top=-1945
Width=5303 Width=5303
Height=3835 Height=3828
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=5303 ClientWidth=5303
ClientHeight=3835 ClientHeight=3828
TBDockHeight=3835 TBDockHeight=3828
LRDockWidth=5303 LRDockWidth=5303
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -387,36 +498,16 @@ State=0
Left=0 Left=0
Top=0 Top=0
Width=1289 Width=1289
Height=2358 Height=2357
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=1289 ClientWidth=1289
ClientHeight=2358 ClientHeight=2357
TBDockHeight=4878 TBDockHeight=4877
LRDockWidth=5303 LRDockWidth=5303
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
[PropertyInspector]
PercentageSizes=1
Create=1
Visible=1
Docked=1
State=0
Left=0
Top=0
Width=2920
Height=7696
MaxLeft=-1
MaxTop=-1
ClientWidth=2920
ClientHeight=7696
TBDockHeight=5813
LRDockWidth=1543
Dockable=1
StayOnTop=0
SplitPos=73
[BreakpointWindow] [BreakpointWindow]
PercentageSizes=1 PercentageSizes=1
Create=1 Create=1
@ -424,14 +515,14 @@ Visible=0
Docked=0 Docked=0
State=0 State=0
Left=88 Left=88
Top=7453 Top=7452
Width=6396 Width=6396
Height=2276 Height=2275
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=6318 ClientWidth=6318
ClientHeight=1924 ClientHeight=1921
TBDockHeight=203 TBDockHeight=204
LRDockWidth=6396 LRDockWidth=6396
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -445,18 +536,18 @@ Column5Width=75
[StructureView] [StructureView]
PercentageSizes=1 PercentageSizes=1
Create=1 Create=1
Visible=0 Visible=1
Docked=0 Docked=0
State=0 State=0
Left=0 Left=0
Top=1192 Top=1185
Width=1670 Width=1670
Height=3469 Height=3474
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=1592 ClientWidth=1592
ClientHeight=3117 ClientHeight=3120
TBDockHeight=3469 TBDockHeight=3474
LRDockWidth=1670 LRDockWidth=1670
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -468,14 +559,14 @@ Visible=0
Docked=0 Docked=0
State=0 State=0
Left=78 Left=78
Top=7656 Top=7657
Width=9863 Width=9863
Height=2209 Height=2207
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=9785 ClientWidth=9785
ClientHeight=1856 ClientHeight=1853
TBDockHeight=1098 TBDockHeight=1104
LRDockWidth=1504 LRDockWidth=1504
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -483,18 +574,18 @@ StayOnTop=0
[MessageView@EditWindow0] [MessageView@EditWindow0]
PercentageSizes=1 PercentageSizes=1
Create=1 Create=1
Visible=0 Visible=1
Docked=1 Docked=1
State=0 State=0
Left=-179 Left=0
Top=-726 Top=23
Width=2773 Width=6719
Height=1152 Height=2956
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=2773 ClientWidth=6719
ClientHeight=1152 ClientHeight=2956
TBDockHeight=1152 TBDockHeight=2956
LRDockWidth=2773 LRDockWidth=2773
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -508,58 +599,35 @@ State=0
Left=-179 Left=-179
Top=-113 Top=-113
Width=1465 Width=1465
Height=8266 Height=8270
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=1465 ClientWidth=1465
ClientHeight=8266 ClientHeight=8270
TBDockHeight=8266 TBDockHeight=8270
LRDockWidth=1465 LRDockWidth=1465
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
[DockHosts] [DockHosts]
DockHostCount=3 DockHostCount=2
[DockSite0] [DockSite0]
DockSiteType=1 DockSiteType=1
PercentageSizes=1 PercentageSizes=1
Create=1 Create=1
Visible=1
Docked=0
State=0
Left=-10
Top=1369
Width=3076
Height=8523
MaxLeft=-10
MaxTop=-14
ClientWidth=2998
ClientHeight=8171
TBDockHeight=8523
LRDockWidth=3076
Dockable=1
StayOnTop=0
TabPosition=0
ActiveTabID=ToolForm
TabDockClients=PropertyInspector,ToolForm
[DockSite1]
DockSiteType=1
PercentageSizes=1
Create=1
Visible=0 Visible=0
Docked=1 Docked=1
State=0 State=0
Left=-179 Left=693
Top=-726 Top=-396
Width=4385 Width=4385
Height=1870 Height=1866
MaxLeft=-1 MaxLeft=-1
MaxTop=-1 MaxTop=-1
ClientWidth=4385 ClientWidth=4385
ClientHeight=1870 ClientHeight=1866
TBDockHeight=1870 TBDockHeight=1866
LRDockWidth=4385 LRDockWidth=4385
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0
@ -567,22 +635,22 @@ TabPosition=1
ActiveTabID=RefactoringForm ActiveTabID=RefactoringForm
TabDockClients=RefactoringForm,FindReferencsForm,UsagesView,RefactoringsView,QAView,MetricsView TabDockClients=RefactoringForm,FindReferencsForm,UsagesView,RefactoringsView,QAView,MetricsView
[DockSite2] [DockSite1]
DockSiteType=1 DockSiteType=1
PercentageSizes=1 PercentageSizes=1
Create=1 Create=1
Visible=0 Visible=1
Docked=0 Docked=0
State=0 State=0
Left=8516 Left=8516
Top=1125 Top=1131
Width=1445 Width=1445
Height=3184 Height=3188
MaxLeft=-10 MaxLeft=-10
MaxTop=-14 MaxTop=-14
ClientWidth=1367 ClientWidth=1367
ClientHeight=2832 ClientHeight=2834
TBDockHeight=3184 TBDockHeight=3188
LRDockWidth=1445 LRDockWidth=1445
Dockable=1 Dockable=1
StayOnTop=0 StayOnTop=0

BIN
CPRS-Chart/CPRSChart.exe
View File

Binary file not shown.

BIN
CPRS-Chart/CPRSChart.identcache
View File

Binary file not shown.

137075
CPRS-Chart/CPRSChart.map
View File

File diff suppressed because it is too large Load Diff

BIN
CPRS-Chart/CPRSChart.res
View File

Binary file not shown.

BIN
CPRS-Chart/CPRSChart.tlb
View File

Binary file not shown.

6
CPRS-Chart/CPRSChart_TLB.pas
View File

@ -11,11 +11,11 @@ unit CPRSChart_TLB;
// manual modifications will be lost. // manual modifications will be lost.
// ************************************************************************ // // ************************************************************************ //
// PASTLWTR : 1.2 // $Rev: 8291 $
// File generated on 6/26/2010 8:43:12 PM from Type Library described below. // File generated on 5/2/2015 5:57:00 PM from Type Library described below.
// ************************************************************************ // // ************************************************************************ //
// Type Lib: P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-chart\CPRSChart.tlb (1) // Type Lib: E:\Vista_30_28\OR_SRC_CREATION\CPRS-Chart\CPRSChart.tlb (1)
// LIBID: {0A4A6086-6504-11D5-82DE-00C04F72C274} // LIBID: {0A4A6086-6504-11D5-82DE-00C04F72C274}
// LCID: 0 // LCID: 0
// Helpfile: // Helpfile:

25
CPRS-Chart/Consults/fConsultAct.dfm
View File

@ -3,30 +3,34 @@ inherited frmConsultAction: TfrmConsultAction
Top = 217 Top = 217
BorderIcons = [] BorderIcons = []
Caption = 'frmConsultAction' Caption = 'frmConsultAction'
ClientHeight = 379 ClientHeight = 429
ClientWidth = 592 ClientWidth = 592
Constraints.MinHeight = 406 Constraints.MinHeight = 406
Constraints.MinWidth = 600 Constraints.MinWidth = 600
OldCreateOrder = True OldCreateOrder = True
Position = poScreenCenter Position = poScreenCenter
ExplicitWidth = 600
ExplicitHeight = 456
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pnlBase: TPanel [0] object pnlBase: TPanel [0]
Left = 0 Left = 0
Top = 0 Top = 0
Width = 592 Width = 592
Height = 379 Height = 429
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 0 TabOrder = 0
ExplicitHeight = 379
object pnlForward: TPanel object pnlForward: TPanel
Left = 0 Left = 0
Top = 0 Top = 0
Width = 224 Width = 224
Height = 379 Height = 429
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 0 TabOrder = 0
ExplicitHeight = 379
object lblToService: TOROffsetLabel object lblToService: TOROffsetLabel
Left = 2 Left = 2
Top = 0 Top = 0
@ -169,10 +173,11 @@ inherited frmConsultAction: TfrmConsultAction
Left = 224 Left = 224
Top = 0 Top = 0
Width = 368 Width = 368
Height = 379 Height = 429
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
ExplicitHeight = 379
object pnlSigFind: TPanel object pnlSigFind: TPanel
Left = 0 Left = 0
Top = 0 Top = 0
@ -201,11 +206,12 @@ inherited frmConsultAction: TfrmConsultAction
Left = 0 Left = 0
Top = 57 Top = 57
Width = 368 Width = 368
Height = 224 Height = 274
Align = alClient Align = alClient
Alignment = taLeftJustify Alignment = taLeftJustify
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
ExplicitHeight = 224
object lblComments: TOROffsetLabel object lblComments: TOROffsetLabel
Left = 0 Left = 0
Top = 0 Top = 0
@ -222,7 +228,7 @@ inherited frmConsultAction: TfrmConsultAction
Left = 0 Left = 0
Top = 19 Top = 19
Width = 368 Width = 368
Height = 170 Height = 220
Align = alClient Align = alClient
Font.Charset = ANSI_CHARSET Font.Charset = ANSI_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -233,15 +239,17 @@ inherited frmConsultAction: TfrmConsultAction
ScrollBars = ssVertical ScrollBars = ssVertical
TabOrder = 0 TabOrder = 0
Caption = 'Comments' Caption = 'Comments'
ExplicitHeight = 170
end end
object pnlAlert: TPanel object pnlAlert: TPanel
Left = 0 Left = 0
Top = 189 Top = 239
Width = 368 Width = 368
Height = 35 Height = 35
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
ExplicitTop = 189
object lblAutoAlerts: TStaticText object lblAutoAlerts: TStaticText
Left = 6 Left = 6
Top = 1 Top = 1
@ -262,12 +270,13 @@ inherited frmConsultAction: TfrmConsultAction
end end
object pnlAllActions: TPanel object pnlAllActions: TPanel
Left = 0 Left = 0
Top = 281 Top = 331
Width = 368 Width = 368
Height = 98 Height = 98
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 2 TabOrder = 2
ExplicitTop = 281
DesignSize = ( DesignSize = (
368 368
98) 98)

71
CPRS-Chart/Consults/fConsultAct.pas
View File

@ -152,11 +152,15 @@ function TfrmConsultAction.SetupForward(IsProcedure: boolean; ProcIEN: integer):
var var
i: integer; i: integer;
OrdItmIEN: integer; OrdItmIEN: integer;
attention: string; //wat cq 15561
AList: TStringList; {WAT cq 19626}
begin begin
pnlSigFind.Visible := False; pnlSigFind.Visible := False;
with frmConsultAction do Height := Height - pnlSigFind.Height; with frmConsultAction do Height := Height - pnlSigFind.Height;
pnlComments.Visible := True; pnlComments.Visible := True;
memComments.Clear; memComments.Clear;
AList := TStringList.Create;
try {WAT cq 19626}
if IsProcedure then if IsProcedure then
begin begin
OrdItmIEN := GetOrderableIEN(IntToStr(ConsultRec.ORFileNumber)); OrdItmIEN := GetOrderableIEN(IntToStr(ConsultRec.ORFileNumber));
@ -182,7 +186,9 @@ begin
end end
else else
begin begin
SortByPiece(TStringList(SvcList), U, 2); {RV} FastAssign(SvcList, AList); {WAT cq 19626}
SortByPiece(AList, U, 2); {WAT cq 19626}
//SortByPiece(TStringList(SvcList), U, 2); {RV}
for i := 0 to SvcList.Count - 1 do for i := 0 to SvcList.Count - 1 do
if (cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1) and {RV} if (cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1) and {RV}
(Piece(SvcList.Strings[i], U, 5) <> '1') then (Piece(SvcList.Strings[i], U, 5) <> '1') then
@ -199,11 +205,17 @@ begin
Selected := Items[0] ; Selected := Items[0] ;
end ; end ;
end; end;
pnlForward.Visible := True ; pnlForward.Visible := True ;
end ; end ;
if cboService.Items.Count = 1 then cboService.ItemIndex := 0; if cboService.Items.Count = 1 then cboService.ItemIndex := 0;
FToService := cboService.ItemIEN; FToService := cboService.ItemIEN;
cboAttentionOf.InitLongList('') ; //wat cq 15561
//cboAttentionOf.InitLongList('') ;
FAttentionOf := ConsultRec.Attention;
attention := ExternalName(FAttentionOf,200);
cboAttentionOf.InitLongList(attention);
cboAttentionOf.SelectByIEN(FAttentionOf);
//end cq 15561
with cboUrgency do with cboUrgency do
begin begin
FastAssign(SubsetofUrgencies(ConsultRec.IEN), cboUrgency.Items) ; FastAssign(SubsetofUrgencies(ConsultRec.IEN), cboUrgency.Items) ;
@ -223,10 +235,13 @@ begin
cboPerson.Caption := lblActionBy.Caption; cboPerson.Caption := lblActionBy.Caption;
cboPerson.OnNeedData := NewPersonNeedData; // cboPerson.OnNeedData := NewPersonNeedData; //
cboPerson.InitLongList(User.Name) ; cboPerson.InitLongList(User.Name) ;
cboPerson.SelectByIEN(User.DUZ); cboPerson.SelectByIEN(User.DUZ);
ckAlert.Visible := False ; ckAlert.Visible := False ;
lblAutoAlerts.Visible := False; lblAutoAlerts.Visible := False;
Result := True; Result := True;
finally
AList.Free; {WAT cq 19626}
end;
end; end;
procedure TfrmConsultAction.SetupAddComment; procedure TfrmConsultAction.SetupAddComment;
@ -600,30 +615,30 @@ var
x: string; x: string;
begin begin
case FUserLevel of case FUserLevel of
UL_NONE, UL_REVIEW: UL_NONE, UL_REVIEW:
begin begin
if FUserIsRequester then if FUserIsRequester then
x := TX_ALERT1 + TX_ALERT_SVC_USERS x := TX_ALERT1 + TX_ALERT_SVC_USERS
else else
x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS; x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
end; end;
UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN: UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN:
begin begin
if FUserIsRequester then if FUserIsRequester then
//x := TX_ALERT_NOBODY Replace with following line //x := TX_ALERT_NOBODY Replace with following line
x := TX_ALERT1 + TX_ALERT_SVC_USERS x := TX_ALERT1 + TX_ALERT_SVC_USERS
else else
x := TX_ALERT1 + TX_ALERT_PROVIDER + '.'; x := TX_ALERT1 + TX_ALERT_PROVIDER + '.';
end; end;
UL_UNRESTRICTED: UL_UNRESTRICTED:
begin begin
if FUserIsRequester then if FUserIsRequester then
x := TX_ALERT1 + TX_ALERT_SVC_USERS x := TX_ALERT1 + TX_ALERT_SVC_USERS
else else
x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS; x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
end; end;
end; end;
lblAutoAlerts.Caption := x; lblAutoAlerts.Caption := x;
end; end;

7
CPRS-Chart/Consults/fConsults.dfm
View File

@ -10,7 +10,7 @@ inherited frmConsults: TfrmConsults
OnHide = FormHide OnHide = FormHide
OnShow = FormShow OnShow = FormShow
ExplicitWidth = 723 ExplicitWidth = 723
ExplicitHeight = 467 ExplicitHeight = 475
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
inherited shpPageBottom: TShape inherited shpPageBottom: TShape
@ -660,6 +660,11 @@ inherited frmConsults: TfrmConsults
ShortCut = 16453 ShortCut = 16453
OnClick = cmdPCEClick OnClick = cmdPCEClick
end end
object popNoteMemoViewCslt: TMenuItem
Caption = 'View Consult Details'
ShortCut = 24661
OnClick = popNoteMemoViewCsltClick
end
end end
object popConsultList: TPopupMenu object popConsultList: TPopupMenu
Left = 523 Left = 523

226
CPRS-Chart/Consults/fConsults.pas
View File

@ -179,6 +179,7 @@ type
imgLblNotes: TVA508ImageListLabeler; imgLblNotes: TVA508ImageListLabeler;
imgLblImages: TVA508ImageListLabeler; imgLblImages: TVA508ImageListLabeler;
imgLblConsults: TVA508ImageListLabeler; imgLblConsults: TVA508ImageListLabeler;
popNoteMemoViewCslt: TMenuItem; //wat cq 17586
procedure mnuChartTabClick(Sender: TObject); procedure mnuChartTabClick(Sender: TObject);
procedure lstConsultsClick(Sender: TObject); procedure lstConsultsClick(Sender: TObject);
procedure pnlRightResize(Sender: TObject); procedure pnlRightResize(Sender: TObject);
@ -284,6 +285,7 @@ type
procedure pnlRightExit(Sender: TObject); procedure pnlRightExit(Sender: TObject);
procedure cmdEditResubmitExit(Sender: TObject); procedure cmdEditResubmitExit(Sender: TObject);
procedure cmdNewConsultExit(Sender: TObject); procedure cmdNewConsultExit(Sender: TObject);
procedure popNoteMemoViewCsltClick(Sender: TObject); //wat cq 17586
private private
FocusToRightPanel : Boolean; FocusToRightPanel : Boolean;
FEditingIndex: Integer; // TIU index of document being currently edited FEditingIndex: Integer; // TIU index of document being currently edited
@ -347,6 +349,8 @@ type
procedure DoAttachIDChild(AChild, AParent: TORTreeNode); procedure DoAttachIDChild(AChild, AParent: TORTreeNode);
function UserIsSigner(NoteIEN: integer): boolean; function UserIsSigner(NoteIEN: integer): boolean;
public public
function CustomCanFocus(Control: TWinControl): Boolean; //CB
function LinesVisible(richedit: Trichedit): integer; //CB
function ActiveEditOf(AnIEN: Int64): Boolean; function ActiveEditOf(AnIEN: Int64): Boolean;
function AllowContextChange(var WhyNot: string): Boolean; override; function AllowContextChange(var WhyNot: string): Boolean; override;
procedure ClearPtData; override; procedure ClearPtData; override;
@ -364,6 +368,7 @@ type
property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published
end; end;
var var
frmConsults: TfrmConsults; frmConsults: TfrmConsults;
@ -637,8 +642,9 @@ begin
FCurrentContext := AContext; FCurrentContext := AContext;
CurrNotifIEN := 0; CurrNotifIEN := 0;
EditingIndex := -1; EditingIndex := -1;
tvConsults.Enabled := True; pnlConsultList.Enabled := True; //CQ#15785
lstConsults.Enabled := True ; // tvConsults.Enabled := True;
// lstConsults.Enabled := True ;
lstNotes.Enabled := True ; lstNotes.Enabled := True ;
pnlRead.BringToFront ; pnlRead.BringToFront ;
memConsult.TabStop := True; memConsult.TabStop := True;
@ -768,8 +774,9 @@ begin
TmpBoilerPlate := nil; TmpBoilerPlate := nil;
try try
ClearEditControls; ClearEditControls;
tvConsults.Enabled := False; pnlConsultList.Enabled := False; //CQ#15785
lstConsults.Enabled := False ; // tvConsults.Enabled := False;
// lstConsults.Enabled := False ;
FillChar(FEditNote, SizeOf(FEditNote), 0); //v15.7 FillChar(FEditNote, SizeOf(FEditNote), 0); //v15.7
with FEditNote do with FEditNote do
begin begin
@ -898,8 +905,9 @@ begin
if not HaveRequired then if not HaveRequired then
begin begin
ClearEditControls; ClearEditControls;
lstConsults.Enabled := True; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True;
// tvConsults.Enabled := True;
end; end;
SetResultMenus ; SetResultMenus ;
finally finally
@ -929,8 +937,9 @@ var
begin begin
AClassName := DCL_CONSULTS; AClassName := DCL_CONSULTS;
ClearEditControls; ClearEditControls;
lstConsults.Enabled := False ; pnlConsultList.Enabled := False; //CQ#15785
tvConsults.Enabled := False; // lstConsults.Enabled := False ;
// tvConsults.Enabled := False;
with FEditNote do with FEditNote do
begin begin
DocType := TYP_ADDENDUM; DocType := TYP_ADDENDUM;
@ -1007,8 +1016,9 @@ begin
//if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult); //if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult);
InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK); InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
HaveRequired := False; HaveRequired := False;
lstConsults.Enabled := True; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True;
// tvConsults.Enabled := True;
end; {if CreatedNote.IEN} end; {if CreatedNote.IEN}
end; {if HaveRequired} end; {if HaveRequired}
if not HaveRequired then ClearEditControls; if not HaveRequired then ClearEditControls;
@ -1558,6 +1568,26 @@ begin
else if NoteIEN = -1 then Exit else if NoteIEN = -1 then Exit
end; end;
//wat cq 17586
procedure TfrmConsults.popNoteMemoViewCsltClick(Sender: TObject);
var
CsltIEN: integer ;
ConsultDetail: TStringList;
x: string;
begin
inherited;
if (Screen.ActiveControl <> memResults) or (FEditNote.PkgPtr <> PKG_CONSULTS) then Exit;
CsltIEN := frmConsults.FEditNote.PkgIEN;
x := FindConsult(CsltIEN);
ConsultDetail := TStringList.Create;
try
LoadConsultDetail(ConsultDetail, CsltIEN) ;
ReportBox(ConsultDetail, 'Consult Details: #' + IntToStr(CsltIEN) + ' - ' + Piece(x, U, 4), TRUE);
finally
ConsultDetail.Free;
end;
end; //END cq 17586
procedure TfrmConsults.mnuActAddIDEntryClick(Sender: TObject); procedure TfrmConsults.mnuActAddIDEntryClick(Sender: TObject);
const const
IS_ID_CHILD = True; IS_ID_CHILD = True;
@ -1791,8 +1821,9 @@ begin
cmdPCE.Visible := FALSE; cmdPCE.Visible := FALSE;
popNoteMemoEncounter.Visible := FALSE; popNoteMemoEncounter.Visible := FALSE;
UpdateList; UpdateList;
lstConsults.Enabled := True ; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
with tvConsults do Selected := FindPieceNode(IntToStr(SaveConsult), 1, U, Items.GetFirstNode); with tvConsults do Selected := FindPieceNode(IntToStr(SaveConsult), 1, U, Items.GetFirstNode);
tvConsultsClick(Self); tvConsultsClick(Self);
(* lstConsults.SelectByIEN(ConsultRec.IEN); (* lstConsults.SelectByIEN(ConsultRec.IEN);
@ -1850,8 +1881,9 @@ begin
begin begin
pnlResults.Visible := False; pnlResults.Visible := False;
pnlResults.SendToBack; pnlResults.SendToBack;
lstConsults.Enabled := True; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True;
// tvConsults.Enabled := True;
if Notifications.Active then if Notifications.Active then
with tvConsults do with tvConsults do
begin begin
@ -1970,8 +2002,9 @@ begin
begin begin
pnlResults.Visible := False; pnlResults.Visible := False;
pnlResults.SendToBack; pnlResults.SendToBack;
lstConsults.Enabled := True; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True;
// tvConsults.Enabled := True;
if Notifications.Active then if Notifications.Active then
with tvConsults do with tvConsults do
begin begin
@ -2181,8 +2214,9 @@ begin
FActionType := TMenuItem(Sender).Tag ; FActionType := TMenuItem(Sender).Tag ;
ClearEditControls ; ClearEditControls ;
lstNotes.Enabled := False ; lstNotes.Enabled := False ;
lstConsults.Enabled := False ; pnlConsultList.Enabled := False; //CQ#15785
tvConsults.Enabled := False; // lstConsults.Enabled := False ;
// tvConsults.Enabled := False;
x := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 12); x := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 12);
if x <> '' then if x <> '' then
IsProcedure := (x[1] in ['P', 'M']) IsProcedure := (x[1] in ['P', 'M'])
@ -2222,8 +2256,9 @@ begin
UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0)); // v20.4 RV (unlocking problem) UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0)); // v20.4 RV (unlocking problem)
//UnlockConsultRequest(lstNotes.ItemIEN, lstConsults.ItemIEN); //UnlockConsultRequest(lstNotes.ItemIEN, lstConsults.ItemIEN);
lstNotes.Enabled := True ; lstNotes.Enabled := True ;
lstConsults.Enabled := True ; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
end; end;
procedure TfrmConsults.UpdateList; procedure TfrmConsults.UpdateList;
@ -2395,7 +2430,6 @@ begin
(MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
(MenuAccessRec.UserLevel = UL_UNRESTRICTED)) (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
and and
(ConsultRec.ORStatus=ST_COMPLETE) and
((lstNotes.ItemIndex > -1) and ((lstNotes.ItemIndex > -1) and
((ConsultRec.TIUResultNarrative>0) or ((ConsultRec.TIUResultNarrative>0) or
(lstNotes.ItemIEN > 0))); (lstNotes.ItemIEN > 0)));
@ -2624,8 +2658,9 @@ begin
with lstNotes do with lstNotes do
if ItemIndex = EditingIndex then if ItemIndex = EditingIndex then
begin begin
lstConsults.Enabled := False ; pnlConsultList.Enabled := False; //CQ#15785
tvConsults.Enabled := False; // lstConsults.Enabled := False ;
// tvConsults.Enabled := False;
pnlResults.Visible := True; pnlResults.Visible := True;
pnlResults.BringToFront; pnlResults.BringToFront;
memConsult.TabStop := False; memConsult.TabStop := False;
@ -2638,8 +2673,9 @@ begin
StatusText('Retrieving selected item...'); StatusText('Retrieving selected item...');
if EditingIndex = -1 then if EditingIndex = -1 then
begin begin
lstConsults.Enabled := True ; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
end; end;
lblTitle.Caption := MakeConsultNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]); lblTitle.Caption := MakeConsultNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]);
lblTitle.Hint := lblTitle.Caption; lblTitle.Hint := lblTitle.Caption;
@ -2709,6 +2745,7 @@ begin
popNoteMemoReplace.Enabled := (FEditCtrl.GetTextLen > 0); popNoteMemoReplace.Enabled := (FEditCtrl.GetTextLen > 0);
popNoteMemoPreview.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected); popNoteMemoPreview.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
popNoteMemoInsTemplate.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected); popNoteMemoInsTemplate.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
popNoteMemoViewCslt.Enabled := (FEditNote.PkgPtr = PKG_CONSULTS); //wat cq 17586
end else end else
begin begin
popNoteMemoSpell.Enabled := False; popNoteMemoSpell.Enabled := False;
@ -2717,6 +2754,7 @@ begin
popNoteMemoReplace.Enabled := False; popNoteMemoReplace.Enabled := False;
popNoteMemoPreview.Enabled := False; popNoteMemoPreview.Enabled := False;
popNoteMemoInsTemplate.Enabled := False; popNoteMemoInsTemplate.Enabled := False;
popNoteMemoViewCslt.Enabled := FALSE; //wat cq 17586
end; end;
end; end;
@ -2837,21 +2875,27 @@ begin
end; end;
end; end;
{for printing multiple notes}
procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList); procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList);
var var
NoteIEN: int64; NoteIEN: int64;
i: integer; i: integer;
begin begin
inherited;
with AForm.lbIDParents do with AForm.lbIDParents do
for i := 0 to Items.Count - 1 do
if Selected[i] then
begin begin
NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0); for i := 0 to Items.Count - 1 do
if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) begin
else if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK) if Selected[i] then
else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK); begin
end; NoteIEN := ItemIEN; //StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0);
if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) else
begin
if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
if NoteIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
end;
end; {if selected}
end; {for}
end; {with}
end; end;
procedure TfrmConsults.mnuActDisplayResultsClick(Sender: TObject); procedure TfrmConsults.mnuActDisplayResultsClick(Sender: TObject);
@ -3103,6 +3147,10 @@ var
Saved: boolean; Saved: boolean;
AnObject: PDocTreeObject; AnObject: PDocTreeObject;
tmpNode: TORTreeNode; tmpNode: TORTreeNode;
I:Integer;
CommentDate: String;
Format: CHARFORMAT2;
VisibleLineCount: integer;
begin begin
if EditingIndex <> -1 then if EditingIndex <> -1 then
begin begin
@ -3115,8 +3163,9 @@ begin
lblConsults.Caption := Notifications.Text; lblConsults.Caption := Notifications.Text;
tvConsults.Caption := Notifications.Text; tvConsults.Caption := Notifications.Text;
EditingIndex := -1; EditingIndex := -1;
lstConsults.Enabled := True ; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
lstNotes.Enabled := True ; lstNotes.Enabled := True ;
pnlRead.BringToFront ; pnlRead.BringToFront ;
memConsult.TabStop := True; memConsult.TabStop := True;
@ -3203,9 +3252,40 @@ begin
end; end;
tvCsltNotesChange(Self, tvCsltNotes.Selected); tvCsltNotesChange(Self, tvCsltNotes.Selected);
end end
else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0) then else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0)
and (Pos(UpperCase('Comment added'), UpperCase(Notifications.Text)) = 0) then //CB
mnuActDisplayResultsClick(Self); mnuActDisplayResultsClick(Self);
//CB
If (Notifications.HighLightSection <> '') and (Pos(UpperCase('Comment added'), UpperCase(Notifications.Text)) > 0) then begin
CommentDate := FormatDateTime('mm/dd/yy hh:mm', StrToDateTime(StringReplace(Notifications.HighLightSection, '@', ' ', [rfReplaceAll])) );
for I := 0 to memConsult.Lines.Count - 1 do begin
If (Pos(CommentDate, memConsult.Lines.Strings[i]) > 0) and (Pos(UpperCase('ADDED COMMENT'), UpperCase(memConsult.Lines.Strings[i])) > 0) then begin
if CustomCanFocus(memconsult) then
memConsult.SetFocus;
memConsult.SelStart := memConsult.Perform(EM_LINEINDEX, i,0);
memConsult.SelLength := Length(memConsult.Lines.Strings[i]);
//Set the background color
Format.cbSize := SizeOf(Format);
Format.dwMask := CFM_BACKCOLOR;
Format.crBackColor := clRed;
memConsult.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
//Get visible Line Couunt
VisibleLineCount := LinesVisible(memConsult);
if (I + VisibleLineCount)>= memConsult.Lines.Count - 1 then
memConsult.SelStart := memConsult.Perform(EM_LINEINDEX, memConsult.Lines.Count - 1,0)
else memConsult.SelStart := memConsult.Perform(EM_LINEINDEX,I + VisibleLineCount - 1,0);
memConsult.Perform($00B7, 0, 0); //EM_SETCARRET DEFINED WRONG in Richedit.pas
memConsult.SelLength := 0;
break;
end;
end;
end;
case Notifications.Followup of case Notifications.Followup of
NF_CONSULT_REQUEST_RESOLUTION : Notifications.Delete; NF_CONSULT_REQUEST_RESOLUTION : Notifications.Delete;
NF_NEW_SERVICE_CONSULT_REQUEST : Notifications.Delete; NF_NEW_SERVICE_CONSULT_REQUEST : Notifications.Delete;
@ -3221,6 +3301,53 @@ begin
FNotifPending := False; FNotifPending := False;
end; end;
// *****************************************************************
// Delphi's Can Focus has a bug.
// Source: http://qc.embarcadero.com/wc/qcmain.aspx?d=11229
// *****************************************************************
function TfrmConsults.CustomCanFocus(Control: TWinControl): Boolean;
var
Form: TCustomForm;
begin
Result := False;
Form := GetParentForm(Self);
if Form <> nil then
begin
Control := Self;
repeat
if not (Control.Visible and Control.Enabled) then
Exit;
Control := Control.Parent;
until Control = nil;
Result := True;
end;
end;
function TfrmConsults.LinesVisible(richedit: Trichedit): integer;
Var
OldFont : HFont;
Hand : THandle;
TM : TTextMetric;
Rect : TRect;
tempint : integer;
begin
Hand := GetDC(richedit.Handle);
try
OldFont := SelectObject(Hand, richedit.Font.Handle);
try
GetTextMetrics(Hand, TM);
richedit.Perform(EM_GETRECT, 0, longint(@Rect));
tempint := (Rect.Bottom - Rect.Top) div
(TM.tmHeight + TM.tmExternalLeading);
finally
SelectObject(Hand, OldFont);
end;
finally
ReleaseDC(richedit.Handle, Hand);
end;
Result := tempint;
end;
procedure TfrmConsults.mnuActEditResubmitClick(Sender: TObject); procedure TfrmConsults.mnuActEditResubmitClick(Sender: TObject);
var var
Resubmitted: boolean; Resubmitted: boolean;
@ -3947,8 +4074,9 @@ begin
AConsult := ItemIEN; AConsult := ItemIEN;
if not LockConsultRequest(AConsult) then Exit; if not LockConsultRequest(AConsult) then Exit;
lstNotes.Enabled := False ; lstNotes.Enabled := False ;
lstConsults.Enabled := False ; pnlConsultList.Enabled := False; //CQ#15785
tvConsults.Enabled := False; // lstConsults.Enabled := False ;
// tvConsults.Enabled := False;
if ActionType = 'ATTACH' then if ActionType = 'ATTACH' then
begin begin
FormTitle := TX_ATTACH + Piece(DisplayText[ItemIndex], #9, 3); FormTitle := TX_ATTACH + Piece(DisplayText[ItemIndex], #9, 3);
@ -3979,8 +4107,9 @@ begin
end; end;
end; end;
lstNotes.Enabled := True ; lstNotes.Enabled := True ;
lstConsults.Enabled := True ; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
FOrderID := GetConsultOrderIEN(AConsult); FOrderID := GetConsultOrderIEN(AConsult);
UnlockOrderIfAble(FOrderID); UnlockOrderIfAble(FOrderID);
FOrderID := ''; FOrderID := '';
@ -4067,8 +4196,9 @@ begin
frmDrawers.DisplayDrawers(FALSE); frmDrawers.DisplayDrawers(FALSE);
cmdPCE.Visible := FALSE; cmdPCE.Visible := FALSE;
popNoteMemoEncounter.Visible := FALSE; popNoteMemoEncounter.Visible := FALSE;
lstConsults.Enabled := True ; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
lstNotes.Enabled := True; lstNotes.Enabled := True;
lblTitle.Caption := ''; lblTitle.Caption := '';
lblTitle.Hint := lblTitle.Caption; lblTitle.Hint := lblTitle.Caption;
@ -4434,8 +4564,9 @@ begin
end; end;
popNoteListExpandSelected.Enabled := Selected.HasChildren; popNoteListExpandSelected.Enabled := Selected.HasChildren;
popNoteListCollapseSelected.Enabled := Selected.HasChildren; popNoteListCollapseSelected.Enabled := Selected.HasChildren;
lstConsults.Enabled := True ; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
lstNotes.Enabled := True; lstNotes.Enabled := True;
if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
begin begin
@ -4449,8 +4580,9 @@ begin
frmDrawers.DisplayDrawers(FALSE); frmDrawers.DisplayDrawers(FALSE);
cmdPCE.Visible := FALSE; cmdPCE.Visible := FALSE;
popNoteMemoEncounter.Visible := FALSE; popNoteMemoEncounter.Visible := FALSE;
lstConsults.Enabled := True ; pnlConsultList.Enabled := True; //CQ#15785
tvConsults.Enabled := True; // lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
KillDocTreeObjects(tvCsltNotes); KillDocTreeObjects(tvCsltNotes);
tvCsltNotes.Items.Clear; tvCsltNotes.Items.Clear;
lstNotes.Clear; lstNotes.Clear;

750
CPRS-Chart/Consults/fEditConsult.dfm
View File

@ -1,126 +1,61 @@
inherited frmEditCslt: TfrmEditCslt inherited frmEditCslt: TfrmEditCslt
Tag = 110 Tag = 110
Left = 409 Left = 461
Top = 225 Top = 191
Width = 599 Width = 576
Height = 375 Height = 479
HorzScrollBar.Range = 561 HorzScrollBar.Range = 561
VertScrollBar.Range = 340 VertScrollBar.Range = 340
Caption = 'Edit/Resubmit a Cancelled Consult' Caption = 'Edit/Resubmit a Cancelled Consult'
Constraints.MinHeight = 371 Constraints.MinHeight = 467
Constraints.MinWidth = 573 Constraints.MinWidth = 576
OldCreateOrder = True OldCreateOrder = True
Position = poScreenCenter Position = poScreenCenter
ExplicitLeft = 409 ExplicitWidth = 576
ExplicitTop = 225 ExplicitHeight = 479
ExplicitWidth = 599
ExplicitHeight = 375
DesignSize = ( DesignSize = (
591 568
341) 448)
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblService: TLabel [0] object pnlCombatVet: TPanel [0]
Left = 4 Left = 0
Top = 4 Top = 0
Width = 134 Width = 568
Height = 13 Height = 25
Caption = 'Consult to Service/Specialty' Align = alTop
end BevelOuter = bvLowered
object lblReason: TLabel [1]
Left = 4
Top = 166
Width = 90
Height = 13
Caption = 'Reason for Consult'
end
object lblComment: TLabel [2]
Left = 4
Top = 105
Width = 77
Height = 13
Caption = 'New Comments:'
end
object lblComments: TLabel [3]
Left = 4
Top = 51
Width = 89
Height = 13
Caption = 'Display Comments:'
end
object lblUrgency: TStaticText [4]
Left = 196
Top = 4
Width = 44
Height = 17
Caption = 'Urgency'
TabOrder = 16
end
object lblPlace: TStaticText [5]
Left = 376
Top = 41
Width = 104
Height = 17
Caption = 'Place of Consultation'
TabOrder = 17
end
object lblAttn: TStaticText [6]
Left = 376
Top = 4
Width = 46
Height = 17
Caption = 'Attention'
TabOrder = 18
end
object lblProvDiag: TStaticText [7]
Left = 195
Top = 82
Width = 104
Height = 17
Caption = 'Provisional Diagnosis'
TabOrder = 19
end
object lblInpOutp: TStaticText [8]
Left = 197
Top = 47
Width = 127
Height = 17
Caption = 'Patient will be seen as an:'
TabOrder = 20
end
object memReason: TRichEdit [9]
Left = 4
Top = 179
Width = 589
Height = 137
Anchors = [akLeft, akTop, akRight, akBottom]
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
Font.Name = 'Courier New' Font.Name = 'MS Sans Serif'
Font.Style = [] Font.Style = []
ParentFont = False ParentFont = False
PopupMenu = popReason TabOrder = 0
ScrollBars = ssBoth object txtCombatVet: TVA508StaticText
TabOrder = 11 Name = 'txtCombatVet'
WantTabs = True Left = 1
OnChange = ControlChange Top = 1
OnExit = memReasonExit Width = 566
OnKeyDown = memCommentKeyDown Height = 23
OnKeyPress = memCommentKeyPress Align = alClient
OnKeyUp = memCommentKeyUp Alignment = taCenter
ExplicitHeight = 136 BevelOuter = bvNone
Enabled = False
TabOrder = 0
ShowAccelChar = True
end
end end
object pnlMessage: TPanel [10] object pnlMessage: TPanel [1]
Left = 16 Left = 21
Top = 294 Top = 404
Width = 418 Width = 388
Height = 44 Height = 44
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised BevelInner = bvRaised
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'pnlMessage' Caption = 'pnlMessage'
TabOrder = 15 TabOrder = 4
Visible = False Visible = False
object imgMessage: TImage object imgMessage: TImage
Left = 4 Left = 4
@ -145,230 +80,390 @@ inherited frmEditCslt: TfrmEditCslt
WantReturns = False WantReturns = False
end end
end end
object cboService: TORComboBox [11] object cmdAccept: TButton [2]
Left = 4 Left = 414
Top = 19 Top = 425
Width = 180
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Consult to Service/Specialty'
Color = clWindow
DropDownCount = 8
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
ParentFont = False
Pieces = '2'
Sorted = True
SynonymChars = '<>'
TabOrder = 0
CharsNeedMatch = 1
end
object cboUrgency: TORComboBox [12]
Left = 196
Top = 19
Width = 170
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Urgency'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 1
OnChange = ControlChange
CharsNeedMatch = 1
end
object radInpatient: TRadioButton [13]
Left = 197
Top = 61
Width = 61
Height = 17
Caption = '&Inpatient'
TabOrder = 5
OnClick = radInpatientClick
end
object radOutpatient: TRadioButton [14]
Left = 269
Top = 61
Width = 73
Height = 17
Caption = '&Outpatient'
TabOrder = 6
OnClick = radOutpatientClick
end
object cboPlace: TORComboBox [15]
Left = 376
Top = 54
Width = 216
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Place of Consultation'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 7
OnChange = ControlChange
CharsNeedMatch = 1
end
object txtProvDiag: TCaptionEdit [16]
Left = 195
Top = 95
Width = 346
Height = 21
Anchors = [akLeft, akTop, akRight]
MaxLength = 180
ParentShowHint = False
PopupMenu = mnuPopProvDx
ShowHint = True
TabOrder = 8
OnChange = ControlChange
Caption = 'Provisional Diagnosis'
end
object txtAttn: TORComboBox [17]
Left = 376
Top = 19
Width = 218
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Attention'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 2
MaxLength = 0
Pieces = '2,3'
Sorted = False
SynonymChars = '<>'
TabOrder = 2
OnChange = ControlChange
OnNeedData = txtAttnNeedData
CharsNeedMatch = 1
end
object cboCategory: TORComboBox [18]
Left = 561
Top = 103
Width = 10
Height = 21
Style = orcsDropDown
AutoSelect = True
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
Sorted = False
SynonymChars = '<>'
TabOrder = 14
Visible = False
CharsNeedMatch = 1
end
object cmdAccept: TButton [19]
Left = 437
Top = 319
Width = 72 Width = 72
Height = 21 Height = 21
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'Resubmit' Caption = 'Resubmit'
TabOrder = 12 TabOrder = 2
OnClick = cmdAcceptClick OnClick = cmdAcceptClick
end end
object cmdQuit: TButton [20] object cmdQuit: TButton [3]
Left = 514 Left = 491
Top = 319 Top = 425
Width = 72 Width = 72
Height = 21 Height = 21
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Cancel = True Cancel = True
Caption = 'Cancel' Caption = 'Cancel'
TabOrder = 13 TabOrder = 3
OnClick = cmdQuitClick OnClick = cmdQuitClick
end end
object memComment: TRichEdit [21] object pnlMain: TPanel [4]
Left = 4 Left = 0
Top = 121 Top = 0
Width = 587 Width = 569
Height = 41 Height = 402
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight, akBottom]
PopupMenu = popReason BevelOuter = bvNone
TabOrder = 10 TabOrder = 1
WantTabs = True DesignSize = (
OnChange = ControlChange 569
OnKeyDown = memCommentKeyDown 402)
OnKeyPress = memCommentKeyPress object lblService: TLabel
OnKeyUp = memCommentKeyUp Left = 4
end Top = 4
object btnCmtCancel: TButton [22] Width = 134
Left = 110 Height = 13
Top = 49 Caption = 'Consult to Service/Specialty'
Width = 75 end
Height = 21 object lblReason: TLabel
Caption = 'Cancellation' Left = 4
TabOrder = 3 Top = 227
OnClick = btnCmtCancelClick Width = 95
end Height = 13
object btnCmtOther: TButton [23] Caption = 'Reason for Request'
Left = 110 end
Top = 75 object lblComment: TLabel
Width = 75 Left = 4
Height = 21 Top = 169
Caption = 'Other' Width = 77
TabOrder = 4 Height = 13
OnClick = btnCmtOtherClick Caption = 'New Comments:'
end end
object cmdLexSearch: TButton [24] object lblComments: TLabel
Left = 545 Left = 8
Top = 95 Top = 108
Width = 46 Width = 89
Height = 21 Height = 13
Anchors = [akTop, akRight] Caption = 'Display Comments:'
Caption = 'Lexicon' end
TabOrder = 9 object lblUrgency: TStaticText
OnClick = cmdLexSearchClick Left = 196
Top = 4
Width = 44
Height = 17
Caption = 'Urgency'
TabOrder = 14
end
object lblPlace: TStaticText
Left = 376
Top = 93
Width = 104
Height = 17
Caption = 'Place of Consultation'
TabOrder = 15
end
object lblAttn: TStaticText
Left = 376
Top = 4
Width = 46
Height = 17
Caption = 'Attention'
TabOrder = 16
end
object lblProvDiag: TStaticText
Left = 195
Top = 134
Width = 104
Height = 17
Caption = 'Provisional Diagnosis'
TabOrder = 17
end
object lblInpOutp: TStaticText
Left = 197
Top = 99
Width = 127
Height = 17
Caption = 'Patient will be seen as an:'
TabOrder = 18
end
object memReason: TRichEdit
Left = 4
Top = 240
Width = 559
Height = 161
Anchors = [akLeft, akTop, akRight, akBottom]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
PopupMenu = popReason
ScrollBars = ssBoth
TabOrder = 12
WantTabs = True
OnChange = ControlChange
OnExit = memReasonExit
OnKeyDown = memCommentKeyDown
OnKeyPress = memCommentKeyPress
OnKeyUp = memCommentKeyUp
end
object cboService: TORComboBox
Left = 4
Top = 19
Width = 180
Height = 83
Style = orcsSimple
AutoSelect = True
Caption = 'Consult to Service/Specialty'
Color = clWindow
DropDownCount = 8
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
ParentFont = False
Pieces = '2'
Sorted = True
SynonymChars = '<>'
TabOrder = 0
CharsNeedMatch = 1
end
object cboUrgency: TORComboBox
Left = 196
Top = 19
Width = 170
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Urgency'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 1
OnChange = ControlChange
CharsNeedMatch = 1
end
object radInpatient: TRadioButton
Left = 197
Top = 113
Width = 61
Height = 17
Caption = '&Inpatient'
TabOrder = 6
OnClick = radInpatientClick
end
object radOutpatient: TRadioButton
Left = 269
Top = 113
Width = 73
Height = 17
Caption = '&Outpatient'
TabOrder = 7
OnClick = radOutpatientClick
end
object cboPlace: TORComboBox
Left = 376
Top = 106
Width = 188
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Place of Consultation'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 8
OnChange = ControlChange
CharsNeedMatch = 1
end
object txtProvDiag: TCaptionEdit
Left = 195
Top = 147
Width = 316
Height = 21
Anchors = [akLeft, akTop, akRight]
MaxLength = 180
ParentShowHint = False
PopupMenu = mnuPopProvDx
ShowHint = True
TabOrder = 10
OnChange = ControlChange
Caption = 'Provisional Diagnosis'
end
object txtAttn: TORComboBox
Left = 376
Top = 19
Width = 188
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Attention'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 2
MaxLength = 0
Pieces = '2,3'
Sorted = False
SynonymChars = '<>'
TabOrder = 2
OnChange = ControlChange
OnNeedData = txtAttnNeedData
CharsNeedMatch = 1
end
object cboCategory: TORComboBox
Left = 559
Top = 103
Width = 10
Height = 21
Style = orcsDropDown
AutoSelect = True
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
Sorted = False
SynonymChars = '<>'
TabOrder = 13
Visible = False
CharsNeedMatch = 1
end
object memComment: TRichEdit
Left = 4
Top = 185
Width = 557
Height = 41
Anchors = [akLeft, akTop, akRight]
PopupMenu = popReason
TabOrder = 11
WantTabs = True
OnChange = ControlChange
OnExit = memCommentExit
OnKeyDown = memCommentKeyDown
OnKeyPress = memCommentKeyPress
OnKeyUp = memCommentKeyUp
end
object btnCmtCancel: TButton
Left = 8
Top = 127
Width = 75
Height = 21
Caption = 'Cancellation'
TabOrder = 4
OnClick = btnCmtCancelClick
end
object btnCmtOther: TButton
Left = 110
Top = 127
Width = 75
Height = 21
Caption = 'Other'
TabOrder = 5
OnClick = btnCmtOtherClick
end
object cmdLexSearch: TButton
Left = 515
Top = 147
Width = 46
Height = 21
Anchors = [akTop, akRight]
Caption = 'Lexicon'
TabOrder = 9
OnClick = cmdLexSearchClick
end
object lblEarliest: TStaticText
Left = 197
Top = 46
Width = 121
Height = 17
Caption = 'Earliest appropriate date:'
TabOrder = 19
end
object calEarliest: TORDateBox
Left = 197
Top = 62
Width = 164
Height = 21
TabOrder = 3
OnExit = calEarliestExit
DateOnly = True
RequireTime = False
end
object lblLatest: TStaticText
Left = 376
Top = 46
Width = 116
Height = 17
Caption = 'Latest appropriate date:'
TabOrder = 21
Visible = False
end
object calLatest: TORDateBox
Left = 378
Top = 62
Width = 188
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 22
Visible = False
OnExit = calLatestExit
DateOnly = True
RequireTime = False
end
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
(
'Component = pnlMessage'
'Status = stsDefault')
(
'Component = memMessage'
'Status = stsDefault')
(
'Component = cmdAccept'
'Status = stsDefault')
(
'Component = cmdQuit'
'Status = stsDefault')
(
'Component = frmEditCslt'
'Status = stsDefault')
(
'Component = pnlMain'
'Status = stsDefault')
( (
'Component = lblUrgency' 'Component = lblUrgency'
'Status = stsDefault') 'Status = stsDefault')
@ -387,12 +482,6 @@ inherited frmEditCslt: TfrmEditCslt
( (
'Component = memReason' 'Component = memReason'
'Status = stsDefault') 'Status = stsDefault')
(
'Component = pnlMessage'
'Status = stsDefault')
(
'Component = memMessage'
'Status = stsDefault')
( (
'Component = cboService' 'Component = cboService'
'Status = stsDefault') 'Status = stsDefault')
@ -417,12 +506,6 @@ inherited frmEditCslt: TfrmEditCslt
( (
'Component = cboCategory' 'Component = cboCategory'
'Status = stsDefault') 'Status = stsDefault')
(
'Component = cmdAccept'
'Status = stsDefault')
(
'Component = cmdQuit'
'Status = stsDefault')
( (
'Component = memComment' 'Component = memComment'
'Status = stsDefault') 'Status = stsDefault')
@ -436,12 +519,27 @@ inherited frmEditCslt: TfrmEditCslt
'Component = cmdLexSearch' 'Component = cmdLexSearch'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = frmEditCslt' 'Component = lblEarliest'
'Status = stsDefault')
(
'Component = calEarliest'
'Status = stsDefault')
(
'Component = lblLatest'
'Status = stsDefault')
(
'Component = calLatest'
'Status = stsDefault')
(
'Component = pnlCombatVet'
'Status = stsDefault')
(
'Component = txtCombatVet'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object mnuPopProvDx: TPopupMenu object mnuPopProvDx: TPopupMenu
Left = 353 Left = 353
Top = 77 Top = 129
object mnuPopProvDxDelete: TMenuItem object mnuPopProvDxDelete: TMenuItem
Caption = 'Delete diagnosis' Caption = 'Delete diagnosis'
OnClick = mnuPopProvDxDeleteClick OnClick = mnuPopProvDxDeleteClick
@ -449,8 +547,8 @@ inherited frmEditCslt: TfrmEditCslt
end end
object popReason: TPopupMenu object popReason: TPopupMenu
OnPopup = popReasonPopup OnPopup = popReasonPopup
Left = 411 Left = 523
Top = 169 Top = 369
object popReasonCut: TMenuItem object popReasonCut: TMenuItem
Caption = 'Cu&t' Caption = 'Cu&t'
ShortCut = 16472 ShortCut = 16472

156
CPRS-Chart/Consults/fEditConsult.pas
View File

@ -5,10 +5,26 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
Menus, fBase508Form, VA508AccessibilityManager; Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form;
type type
TfrmEditCslt = class(TfrmBase508Form) TfrmEditCslt = class(TfrmAutoSz)
pnlMessage: TPanel;
imgMessage: TImage;
memMessage: TRichEdit;
cmdAccept: TButton;
cmdQuit: TButton;
pnlMain: TPanel;
lblService: TLabel;
lblReason: TLabel;
lblComment: TLabel;
lblComments: TLabel;
lblUrgency: TStaticText;
lblPlace: TStaticText;
lblAttn: TStaticText;
lblProvDiag: TStaticText;
lblInpOutp: TStaticText;
memReason: TRichEdit;
cboService: TORComboBox; cboService: TORComboBox;
cboUrgency: TORComboBox; cboUrgency: TORComboBox;
radInpatient: TRadioButton; radInpatient: TRadioButton;
@ -16,34 +32,25 @@ type
cboPlace: TORComboBox; cboPlace: TORComboBox;
txtProvDiag: TCaptionEdit; txtProvDiag: TCaptionEdit;
txtAttn: TORComboBox; txtAttn: TORComboBox;
lblReason: TLabel;
lblService: TLabel;
lblUrgency: TStaticText;
lblPlace: TStaticText;
lblAttn: TStaticText;
lblProvDiag: TStaticText;
cboCategory: TORComboBox; cboCategory: TORComboBox;
pnlMessage: TPanel;
imgMessage: TImage;
memMessage: TRichEdit;
cmdAccept: TButton;
cmdQuit: TButton;
memComment: TRichEdit; memComment: TRichEdit;
lblComment: TLabel;
lblComments: TLabel;
btnCmtCancel: TButton; btnCmtCancel: TButton;
btnCmtOther: TButton; btnCmtOther: TButton;
cmdLexSearch: TButton;
lblEarliest: TStaticText;
calEarliest: TORDateBox;
lblLatest: TStaticText;
calLatest: TORDateBox;
mnuPopProvDx: TPopupMenu; mnuPopProvDx: TPopupMenu;
mnuPopProvDxDelete: TMenuItem; mnuPopProvDxDelete: TMenuItem;
cmdLexSearch: TButton;
lblInpOutp: TStaticText;
memReason: TRichEdit;
popReason: TPopupMenu; popReason: TPopupMenu;
popReasonCut: TMenuItem; popReasonCut: TMenuItem;
popReasonCopy: TMenuItem; popReasonCopy: TMenuItem;
popReasonPaste: TMenuItem; popReasonPaste: TMenuItem;
popReasonPaste2: TMenuItem; popReasonPaste2: TMenuItem;
popReasonReformat: TMenuItem; popReasonReformat: TMenuItem;
pnlCombatVet: TPanel;
txtCombatVet: TVA508StaticText;
procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer); Direction, InsertAt: Integer);
procedure radInpatientClick(Sender: TObject); procedure radInpatientClick(Sender: TObject);
@ -68,13 +75,21 @@ type
procedure memCommentKeyDown(Sender: TObject; var Key: Word; procedure memCommentKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
procedure memCommentKeyPress(Sender: TObject; var Key: Char); procedure memCommentKeyPress(Sender: TObject; var Key: Char);
procedure calEarliestExit(Sender: TObject);
procedure calLatestExit(Sender: TObject);
procedure memCommentExit(Sender: TObject);
private private
FLastServiceID: string; FLastServiceID: string;
FChanged: boolean; FChanged: boolean;
FChanging: boolean; FChanging: boolean;
FEditCtrl: TCustomEdit; FEditCtrl: TCustomEdit;
FNavigatingTab: boolean; FNavigatingTab: boolean;
FEarliestDate: TFMDateTime;
FProstheticsSvc: boolean;
//FLatestDate: TFMDateTime;
procedure SetProvDiagPromptingMode; procedure SetProvDiagPromptingMode;
procedure SetUpCombatVet;
procedure SetUpEarliestDate;
protected protected
procedure InitDialog; procedure InitDialog;
procedure Validate(var AnErrMsg: string); procedure Validate(var AnErrMsg: string);
@ -117,6 +132,8 @@ const
TX_INACTIVE_CODE = 'The provisional diagnosis code is not active as of today''s date.' + #13#10 + TX_INACTIVE_CODE = 'The provisional diagnosis code is not active as of today''s date.' + #13#10 +
'Another code must be selected'; 'Another code must be selected';
TC_INACTIVE_CODE = 'Inactive ICD Code'; TC_INACTIVE_CODE = 'Inactive ICD Code';
TX_PAST_DATE = 'Earliest appropriate date must be today or later.';
TX_BAD_DATES = 'Latest appropriate date must be equal to or later than earliest date.';
function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean; function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean;
begin begin
@ -195,6 +212,14 @@ begin
cboPlace.SelectByID(OldRec.Place); cboPlace.SelectByID(OldRec.Place);
with cboUrgency do for i := 0 to Items.Count-1 do with cboUrgency do for i := 0 to Items.Count-1 do
if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i; if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i;
SetUpEarliestDate; //wat v28
if Not FProstheticsSvc then //wat v28
begin
calEarliest.FMDateTime := OldRec.EarliestDate;
FEarliestDate := OldRec.EarliestDate;
//calLatest.FMDateTime := OldRec.LatestDate;
//FLatestDate := OldRec.LatestDate;
end;
txtProvDiag.Text := OldRec.ProvDiagnosis; txtProvDiag.Text := OldRec.ProvDiagnosis;
ProvDx.Code := OldRec.ProvDxCode; ProvDx.Code := OldRec.ProvDxCode;
if OldRec.ProvDxCodeInactive then if OldRec.ProvDxCodeInactive then
@ -212,6 +237,15 @@ begin
else else
txtAttn.ItemIndex := -1; txtAttn.ItemIndex := -1;
SetProvDiagPromptingMode; SetProvDiagPromptingMode;
if (patient.CombatVet.IsEligible = True) then
begin
SetUpCombatVet;
end
else
begin
txtCombatVet.Enabled := False;
pnlCombatVet.SendToBack;
end;
FChanging := False; FChanging := False;
StatusText(''); StatusText('');
end; end;
@ -246,6 +280,13 @@ begin
end; end;
if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
SetError(TX_INACTIVE_CODE); SetError(TX_INACTIVE_CODE);
if Not FProstheticsSvc then //wat v28
begin
if calEarliest.FMDateTime < FMToday then SetError(TX_PAST_DATE);
//if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE);
//if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
end;
end; end;
procedure TfrmEditCslt.txtAttnNeedData(Sender: TObject; procedure TfrmEditCslt.txtAttnNeedData(Sender: TObject;
@ -317,6 +358,22 @@ begin
UrgencyName := ''; UrgencyName := '';
end; end;
if FEarliestDate > 0 then
begin
if FEarliestDate <> OldRec.EarliestDate then
EarliestDate := FEarliestDate
else
EarliestDate := 0;
end;
(* if FLatestDate > 0 then
begin
if FLatestDate <> OldRec.LatestDate then
LatestDate := FLatestDate
else
LatestDate := 0;
end;*)
with cboPlace do if Length(ItemID) > 0 then with cboPlace do if Length(ItemID) > 0 then
if ItemID <> OldRec.Place then if ItemID <> OldRec.Place then
begin begin
@ -407,6 +464,20 @@ begin
if not ValidSave then Action := caNone; if not ValidSave then Action := caNone;
end; end;
procedure TfrmEditCslt.calEarliestExit(Sender: TObject);
begin
inherited;
FEarliestDate := calEarliest.FMDateTime;
ControlChange(Self);
end;
procedure TfrmEditCslt.calLatestExit(Sender: TObject);
begin
inherited;
//FLatestDate := calLatest.FMDateTime;
//ControlChange(Self);
end;
procedure TfrmEditCslt.cmdAcceptClick(Sender: TObject); procedure TfrmEditCslt.cmdAcceptClick(Sender: TObject);
{Begin BillingAware} {Begin BillingAware}
var var
@ -479,6 +550,18 @@ begin
cmdLexSearchClick(Self); cmdLexSearchClick(Self);
end; end;
procedure TfrmEditCslt.SetUpCombatVet;
begin
pnlCombatVet.BringToFront;
txtCombatVet.Enabled := True;
txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
pnlMain.Anchors := [akLeft, akTop, akRight];
self.Height := self.Height + pnlCombatVet.Height;
pnlMain.Anchors := [akLeft, akTop, akRight, akBottom];
ActiveControl := txtCombatVet;
end;
procedure TfrmEditCslt.OrderMessage(const AMessage: string); procedure TfrmEditCslt.OrderMessage(const AMessage: string);
begin begin
@ -654,6 +737,25 @@ begin
end; end;
end; end;
procedure TfrmEditCslt.memCommentExit(Sender: TObject);
//added OnExit code for CQ17822 WAT
var
AStringList: TStringList;
begin
inherited;
AStringList := TStringList.Create;
try
//QuickCopy(memComment, AStringList);
AStringList.Text := memComment.Text;
LimitStringLength(AStringList, 74);
//QuickCopy(AstringList, memComment);
memComment.Text := AStringList.Text;
ControlChange(Self);
finally
AStringList.Free;
end;
end;
procedure TfrmEditCslt.memCommentKeyDown(Sender: TObject; var Key: Word; procedure TfrmEditCslt.memCommentKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
begin begin
@ -670,4 +772,22 @@ begin
Key := #0; //Disable shift-tab processin Key := #0; //Disable shift-tab processin
end; end;
procedure TfrmEditCslt.SetUpEarliestDate; //wat v28
begin
if IsProstheticsService(cboService.ItemIEN) = '1' then
begin
lblEarliest.Enabled := False;
calEarliest.Enabled := False;
calEarliest.Text := '';
FProstheticsSvc := true;
end
else
begin
lblEarliest.Enabled := True;
calEarliest.Enabled := True;
calEarliest.Text := 'TODAY';
FProstheticsSvc := false;
end;
end;
end. end.

840
CPRS-Chart/Consults/fEditProc.dfm
View File

@ -1,364 +1,81 @@
inherited frmEditProc: TfrmEditProc inherited frmEditProc: TfrmEditProc
Tag = 112 Tag = 112
Left = 296 Left = 408
Top = 245 Top = 210
Width = 571 Width = 580
Height = 359 Height = 458
HorzScrollBar.Range = 561 HorzScrollBar.Range = 561
VertScrollBar.Range = 308 VertScrollBar.Range = 308
Caption = 'Edit and resubmit a cancelled procedure' Caption = 'Edit and resubmit a cancelled procedure'
Constraints.MinHeight = 359 Constraints.MinHeight = 458
Constraints.MinWidth = 571 Constraints.MinWidth = 580
OldCreateOrder = True
Position = poScreenCenter Position = poScreenCenter
ExplicitLeft = 296 ExplicitWidth = 580
ExplicitTop = 245 ExplicitHeight = 458
ExplicitWidth = 571
ExplicitHeight = 359
DesignSize = ( DesignSize = (
563 572
325) 424)
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblProc: TLabel [0] object pnlCombatVet: TPanel [0]
Left = 3 Left = 0
Top = 7 Top = 0
Width = 49 Width = 572
Height = 13 Height = 25
Caption = 'Procedure' Align = alTop
end BevelOuter = bvLowered
object lblReason: TLabel [1]
Left = 3
Top = 167
Width = 90
Height = 13
Caption = 'Reason for Consult'
end
object lblService: TOROffsetLabel [2]
Left = 3
Top = 49
Width = 158
Height = 15
Caption = 'Service to perform this procedure'
HorzOffset = 2
Transparent = False
VertOffset = 2
WordWrap = False
end
object lblComment: TLabel [3]
Left = 106
Top = 109
Width = 74
Height = 13
Caption = 'New Comments'
end
object lblComments: TLabel [4]
Left = 3
Top = 99
Width = 89
Height = 13
Caption = 'Display Comments:'
end
object lblUrgency: TStaticText [5]
Left = 190
Top = 7
Width = 44
Height = 17
Caption = 'Urgency'
TabOrder = 18
end
object lblPlace: TStaticText [6]
Left = 362
Top = 50
Width = 104
Height = 17
Caption = 'Place of Consultation'
TabOrder = 19
end
object lblAttn: TStaticText [7]
Left = 362
Top = 7
Width = 46
Height = 17
Caption = 'Attention'
TabOrder = 20
end
object lblProvDiag: TStaticText [8]
Left = 190
Top = 81
Width = 104
Height = 17
Caption = 'Provisional Diagnosis'
TabOrder = 21
end
object lblInpOutp: TStaticText [9]
Left = 192
Top = 48
Width = 127
Height = 17
Caption = 'Patient will be seen as an:'
TabOrder = 17
end
object memReason: TRichEdit [10]
Left = 2
Top = 181
Width = 557
Height = 119
Anchors = [akLeft, akTop, akRight, akBottom]
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
Font.Name = 'Courier New' Font.Name = 'MS Sans Serif'
Font.Style = [] Font.Style = []
ParentFont = False ParentFont = False
PopupMenu = popReason TabOrder = 0
ScrollBars = ssBoth object txtCombatVet: TVA508StaticText
TabOrder = 12 Name = 'txtCombatVet'
WantTabs = True Left = 1
OnChange = ControlChange Top = 1
OnExit = memReasonExit Width = 570
OnKeyDown = memReasonKeyDown Height = 23
OnKeyPress = memReasonKeyPress Align = alClient
OnKeyUp = memCommentKeyUp Alignment = taCenter
BevelOuter = bvNone
Enabled = False
TabOrder = 0
ShowAccelChar = True
end
end end
object cmdAccept: TButton [11] object cmdAccept: TButton [1]
Left = 401 Left = 410
Top = 303 Top = 400
Width = 72 Width = 72
Height = 21 Height = 21
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'Resubmit' Caption = 'Resubmit'
TabOrder = 13 TabOrder = 2
OnClick = cmdAcceptClick OnClick = cmdAcceptClick
end end
object cmdQuit: TButton [12] object cmdQuit: TButton [2]
Left = 486 Left = 495
Top = 303 Top = 400
Width = 72 Width = 72
Height = 21 Height = 21
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Cancel = True Cancel = True
Caption = 'Cancel' Caption = 'Cancel'
TabOrder = 14 TabOrder = 3
OnClick = cmdQuitClick OnClick = cmdQuitClick
end end
object cboUrgency: TORComboBox [13] object pnlMessage: TPanel [3]
Left = 190 Left = 12
Top = 22 Top = 379
Width = 165 Width = 392
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Urgency'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 2
OnChange = ControlChange
CharsNeedMatch = 1
end
object radInpatient: TRadioButton [14]
Left = 190
Top = 61
Width = 61
Height = 17
Caption = '&Inpatient'
TabOrder = 4
OnClick = radInpatientClick
end
object radOutpatient: TRadioButton [15]
Left = 264
Top = 61
Width = 73
Height = 17
Caption = '&Outpatient'
TabOrder = 5
OnClick = radOutpatientClick
end
object cboPlace: TORComboBox [16]
Left = 362
Top = 63
Width = 197
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Place of Consultation'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 6
OnChange = ControlChange
CharsNeedMatch = 1
ExplicitWidth = 195
end
object txtProvDiag: TCaptionEdit [17]
Left = 190
Top = 94
Width = 315
Height = 21
Anchors = [akLeft, akTop, akRight]
MaxLength = 180
ParentShowHint = False
PopupMenu = mnuPopProvDx
ShowHint = True
TabOrder = 7
OnChange = ControlChange
Caption = 'Provisional Diagnosis'
end
object txtAttn: TORComboBox [18]
Left = 362
Top = 22
Width = 197
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Attention'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 2
MaxLength = 0
Pieces = '2,3'
Sorted = False
SynonymChars = '<>'
TabOrder = 3
OnChange = ControlChange
OnNeedData = txtAttnNeedData
CharsNeedMatch = 1
ExplicitWidth = 195
end
object cboProc: TORComboBox [19]
Left = 3
Top = 22
Width = 173
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Procedure'
Color = clWindow
DropDownCount = 8
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 0
MaxLength = 0
ParentFont = False
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 0
OnChange = cboProcSelect
OnNeedData = cboProcNeedData
CharsNeedMatch = 1
end
object cboCategory: TORComboBox [20]
Left = 505
Top = -11
Width = 2
Height = 21
Style = orcsDropDown
AutoSelect = True
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
Sorted = False
SynonymChars = '<>'
TabOrder = 15
Visible = False
OnChange = ControlChange
CharsNeedMatch = 1
end
object cboService: TORComboBox [21]
Left = 3
Top = 65
Width = 173
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Service to perform this procedure'
Color = clWindow
DropDownCount = 8
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
ParentFont = False
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 1
OnChange = ControlChange
CharsNeedMatch = 1
end
object memComment: TRichEdit [22]
Left = 106
Top = 123
Width = 451
Height = 38
Anchors = [akLeft, akTop, akRight]
PopupMenu = popReason
TabOrder = 11
WantTabs = True
OnChange = ControlChange
OnKeyUp = memCommentKeyUp
end
object pnlMessage: TPanel [23]
Left = 19
Top = 276
Width = 383
Height = 44 Height = 44
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised BevelInner = bvRaised
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'pnlMessage' Caption = 'pnlMessage'
TabOrder = 16 TabOrder = 4
Visible = False Visible = False
object imgMessage: TImage object imgMessage: TImage
Left = 4 Left = 4
@ -383,36 +100,412 @@ inherited frmEditProc: TfrmEditProc
WantReturns = False WantReturns = False
end end
end end
object btnCmtCancel: TButton [24] object pnlMain: TPanel [4]
Left = 11 Left = 0
Top = 116 Top = 0
Width = 75 Width = 572
Height = 21 Height = 393
Caption = 'Cancellation' Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 9 BevelOuter = bvNone
OnClick = btnCmtCancelClick TabOrder = 1
end DesignSize = (
object btnCmtOther: TButton [25] 572
Left = 11 393)
Top = 139 object lblProc: TLabel
Width = 75 Left = 3
Height = 21 Top = 7
Caption = 'Other' Width = 49
TabOrder = 10 Height = 13
OnClick = btnCmtOtherClick Caption = 'Procedure'
end end
object cmdLexSearch: TButton [26] object lblReason: TLabel
Left = 509 Left = 8
Top = 94 Top = 225
Width = 49 Width = 95
Height = 21 Height = 13
Anchors = [akTop, akRight] Caption = 'Reason for Request'
Caption = 'Lexicon' end
TabOrder = 8 object lblService: TOROffsetLabel
OnClick = cmdLexSearchClick Left = 3
Top = 49
Width = 158
Height = 15
Caption = 'Service to perform this procedure'
HorzOffset = 2
Transparent = False
VertOffset = 2
WordWrap = False
end
object lblComment: TLabel
Left = 8
Top = 166
Width = 74
Height = 13
Caption = 'New Comments'
end
object lblComments: TLabel
Left = 3
Top = 92
Width = 89
Height = 13
Caption = 'Display Comments:'
end
object lblUrgency: TStaticText
Left = 190
Top = 7
Width = 44
Height = 17
Caption = 'Urgency'
TabOrder = 17
end
object lblPlace: TStaticText
Left = 360
Top = 92
Width = 104
Height = 17
Caption = 'Place of Consultation'
TabOrder = 18
end
object lblAttn: TStaticText
Left = 362
Top = 7
Width = 46
Height = 17
Caption = 'Attention'
TabOrder = 19
end
object lblProvDiag: TStaticText
Left = 188
Top = 136
Width = 104
Height = 17
Caption = 'Provisional Diagnosis'
TabOrder = 20
end
object lblInpOutp: TStaticText
Left = 190
Top = 92
Width = 127
Height = 17
Caption = 'Patient will be seen as an:'
TabOrder = 16
end
object memReason: TRichEdit
Left = 8
Top = 241
Width = 560
Height = 151
Anchors = [akLeft, akTop, akRight, akBottom]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
PopupMenu = popReason
ScrollBars = ssBoth
TabOrder = 14
WantTabs = True
OnChange = ControlChange
OnExit = memReasonExit
OnKeyDown = memReasonKeyDown
OnKeyPress = memReasonKeyPress
OnKeyUp = memCommentKeyUp
end
object cboUrgency: TORComboBox
Left = 190
Top = 22
Width = 165
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Urgency'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 2
OnChange = ControlChange
CharsNeedMatch = 1
end
object radInpatient: TRadioButton
Left = 188
Top = 105
Width = 61
Height = 17
Caption = '&Inpatient'
TabOrder = 8
OnClick = radInpatientClick
end
object radOutpatient: TRadioButton
Left = 255
Top = 105
Width = 73
Height = 17
Caption = '&Outpatient'
TabOrder = 9
OnClick = radOutpatientClick
end
object cboPlace: TORComboBox
Left = 360
Top = 107
Width = 206
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Place of Consultation'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 10
OnChange = ControlChange
CharsNeedMatch = 1
end
object txtProvDiag: TCaptionEdit
Left = 188
Top = 149
Width = 324
Height = 21
Anchors = [akLeft, akTop, akRight]
MaxLength = 180
ParentShowHint = False
PopupMenu = mnuPopProvDx
ShowHint = True
TabOrder = 12
OnChange = ControlChange
Caption = 'Provisional Diagnosis'
end
object txtAttn: TORComboBox
Left = 362
Top = 22
Width = 206
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Attention'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 2
MaxLength = 0
Pieces = '2,3'
Sorted = False
SynonymChars = '<>'
TabOrder = 3
OnChange = ControlChange
OnNeedData = txtAttnNeedData
CharsNeedMatch = 1
end
object cboProc: TORComboBox
Left = 3
Top = 22
Width = 173
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Procedure'
Color = clWindow
DropDownCount = 8
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 0
MaxLength = 0
ParentFont = False
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 0
OnChange = cboProcSelect
OnNeedData = cboProcNeedData
CharsNeedMatch = 1
end
object cboCategory: TORComboBox
Left = 505
Top = -11
Width = 2
Height = 21
Style = orcsDropDown
AutoSelect = True
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
Sorted = False
SynonymChars = '<>'
TabOrder = 15
Visible = False
OnChange = ControlChange
CharsNeedMatch = 1
end
object cboService: TORComboBox
Left = 3
Top = 65
Width = 173
Height = 21
Style = orcsDropDown
AutoSelect = True
Caption = 'Service to perform this procedure'
Color = clWindow
DropDownCount = 8
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
ParentFont = False
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 1
OnChange = ControlChange
CharsNeedMatch = 1
end
object memComment: TRichEdit
Left = 8
Top = 180
Width = 560
Height = 38
Anchors = [akLeft, akTop, akRight]
PopupMenu = popReason
TabOrder = 13
WantTabs = True
OnChange = ControlChange
OnExit = memCommentExit
OnKeyUp = memCommentKeyUp
end
object btnCmtCancel: TButton
Left = 3
Top = 111
Width = 75
Height = 21
Caption = 'Cancellation'
TabOrder = 6
OnClick = btnCmtCancelClick
end
object btnCmtOther: TButton
Left = 84
Top = 111
Width = 75
Height = 21
Caption = 'Other'
TabOrder = 7
OnClick = btnCmtOtherClick
end
object cmdLexSearch: TButton
Left = 516
Top = 149
Width = 49
Height = 21
Anchors = [akTop, akRight]
Caption = 'Lexicon'
TabOrder = 11
OnClick = cmdLexSearchClick
end
object lblEarliest: TStaticText
Left = 190
Top = 49
Width = 121
Height = 17
Caption = 'Earliest appropriate date:'
TabOrder = 21
end
object lblLatest: TStaticText
Left = 361
Top = 49
Width = 116
Height = 17
Caption = 'Latest appropriate date:'
TabOrder = 22
Visible = False
end
object calEarliest: TORDateBox
Left = 190
Top = 65
Width = 164
Height = 21
TabOrder = 4
OnExit = calEarliestExit
DateOnly = True
RequireTime = False
end
object calLatest: TORDateBox
Left = 362
Top = 65
Width = 204
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
Visible = False
OnExit = calLatestExit
DateOnly = True
RequireTime = False
end
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
(
'Component = cmdAccept'
'Status = stsDefault')
(
'Component = cmdQuit'
'Status = stsDefault')
(
'Component = pnlMessage'
'Status = stsDefault')
(
'Component = memMessage'
'Status = stsDefault')
(
'Component = frmEditProc'
'Status = stsDefault')
(
'Component = pnlMain'
'Status = stsDefault')
( (
'Component = lblUrgency' 'Component = lblUrgency'
'Status = stsDefault') 'Status = stsDefault')
@ -431,12 +524,6 @@ inherited frmEditProc: TfrmEditProc
( (
'Component = memReason' 'Component = memReason'
'Status = stsDefault') 'Status = stsDefault')
(
'Component = cmdAccept'
'Status = stsDefault')
(
'Component = cmdQuit'
'Status = stsDefault')
( (
'Component = cboUrgency' 'Component = cboUrgency'
'Status = stsDefault') 'Status = stsDefault')
@ -467,12 +554,6 @@ inherited frmEditProc: TfrmEditProc
( (
'Component = memComment' 'Component = memComment'
'Status = stsDefault') 'Status = stsDefault')
(
'Component = pnlMessage'
'Status = stsDefault')
(
'Component = memMessage'
'Status = stsDefault')
( (
'Component = btnCmtCancel' 'Component = btnCmtCancel'
'Status = stsDefault') 'Status = stsDefault')
@ -483,12 +564,27 @@ inherited frmEditProc: TfrmEditProc
'Component = cmdLexSearch' 'Component = cmdLexSearch'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = frmEditProc' 'Component = lblEarliest'
'Status = stsDefault')
(
'Component = lblLatest'
'Status = stsDefault')
(
'Component = calEarliest'
'Status = stsDefault')
(
'Component = calLatest'
'Status = stsDefault')
(
'Component = pnlCombatVet'
'Status = stsDefault')
(
'Component = txtCombatVet'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object mnuPopProvDx: TPopupMenu object mnuPopProvDx: TPopupMenu
Left = 353 Left = 351
Top = 77 Top = 132
object mnuPopProvDxDelete: TMenuItem object mnuPopProvDxDelete: TMenuItem
Caption = 'Delete diagnosis' Caption = 'Delete diagnosis'
OnClick = mnuPopProvDxDeleteClick OnClick = mnuPopProvDxDeleteClick
@ -496,8 +592,8 @@ inherited frmEditProc: TfrmEditProc
end end
object popReason: TPopupMenu object popReason: TPopupMenu
OnPopup = popReasonPopup OnPopup = popReasonPopup
Left = 411 Left = 539
Top = 169 Top = 361
object popReasonCut: TMenuItem object popReasonCut: TMenuItem
Caption = 'Cu&t' Caption = 'Cu&t'
ShortCut = 16472 ShortCut = 16472

130
CPRS-Chart/Consults/fEditProc.pas
View File

@ -5,47 +5,54 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
Menus, fBase508Form, VA508AccessibilityManager; Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form;
type type
TfrmEditProc = class(TfrmBase508Form) TfrmEditProc = class(TfrmAutoSz)
cmdAccept: TButton; cmdAccept: TButton;
cmdQuit: TButton; cmdQuit: TButton;
pnlMessage: TPanel;
imgMessage: TImage;
memMessage: TRichEdit;
pnlMain: TPanel;
lblProc: TLabel;
lblReason: TLabel;
lblService: TOROffsetLabel;
lblComment: TLabel;
lblComments: TLabel;
lblUrgency: TStaticText;
lblPlace: TStaticText;
lblAttn: TStaticText;
lblProvDiag: TStaticText;
lblInpOutp: TStaticText;
memReason: TRichEdit;
cboUrgency: TORComboBox; cboUrgency: TORComboBox;
radInpatient: TRadioButton; radInpatient: TRadioButton;
radOutpatient: TRadioButton; radOutpatient: TRadioButton;
cboPlace: TORComboBox; cboPlace: TORComboBox;
txtProvDiag: TCaptionEdit; txtProvDiag: TCaptionEdit;
txtAttn: TORComboBox; txtAttn: TORComboBox;
lblProc: TLabel;
cboProc: TORComboBox; cboProc: TORComboBox;
lblReason: TLabel;
lblUrgency: TStaticText;
lblPlace: TStaticText;
lblAttn: TStaticText;
lblProvDiag: TStaticText;
cboCategory: TORComboBox; cboCategory: TORComboBox;
cboService: TORComboBox; cboService: TORComboBox;
lblService: TOROffsetLabel;
memComment: TRichEdit; memComment: TRichEdit;
lblComment: TLabel;
lblComments: TLabel;
pnlMessage: TPanel;
imgMessage: TImage;
memMessage: TRichEdit;
btnCmtCancel: TButton; btnCmtCancel: TButton;
btnCmtOther: TButton; btnCmtOther: TButton;
cmdLexSearch: TButton;
lblEarliest: TStaticText;
lblLatest: TStaticText;
calEarliest: TORDateBox;
calLatest: TORDateBox;
mnuPopProvDx: TPopupMenu; mnuPopProvDx: TPopupMenu;
mnuPopProvDxDelete: TMenuItem; mnuPopProvDxDelete: TMenuItem;
cmdLexSearch: TButton;
lblInpOutp: TStaticText;
memReason: TRichEdit;
popReason: TPopupMenu; popReason: TPopupMenu;
popReasonCut: TMenuItem; popReasonCut: TMenuItem;
popReasonCopy: TMenuItem; popReasonCopy: TMenuItem;
popReasonPaste: TMenuItem; popReasonPaste: TMenuItem;
popReasonPaste2: TMenuItem; popReasonPaste2: TMenuItem;
popReasonReformat: TMenuItem; popReasonReformat: TMenuItem;
pnlCombatVet: TPanel;
txtCombatVet: TVA508StaticText;
procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer); Direction, InsertAt: Integer);
procedure cboProcNeedData(Sender: TObject; const StartFrom: String; procedure cboProcNeedData(Sender: TObject; const StartFrom: String;
@ -73,13 +80,19 @@ type
procedure memReasonKeyDown(Sender: TObject; var Key: Word; procedure memReasonKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
procedure memReasonKeyPress(Sender: TObject; var Key: Char); procedure memReasonKeyPress(Sender: TObject; var Key: Char);
procedure calEarliestExit(Sender: TObject);
procedure calLatestExit(Sender: TObject);
procedure memCommentExit(Sender: TObject);
private private
FLastProcID: string; FLastProcID: string;
FChanged: boolean; FChanged: boolean;
FChanging: boolean; FChanging: boolean;
FEditCtrl: TCustomEdit; FEditCtrl: TCustomEdit;
FNavigatingTab: boolean; FNavigatingTab: boolean;
FEarliestDate: TFMDateTime;
//FLatestDate: TFMDateTime;
procedure SetProvDiagPromptingMode; procedure SetProvDiagPromptingMode;
procedure SetUpCombatVet;
protected protected
procedure InitDialog; procedure InitDialog;
procedure Validate(var AnErrMsg: string); procedure Validate(var AnErrMsg: string);
@ -116,6 +129,8 @@ const
TX_INACTIVE_CODE = 'The provisional diagnosis code is not active as of today''s date.' + #13#10 + TX_INACTIVE_CODE = 'The provisional diagnosis code is not active as of today''s date.' + #13#10 +
'Another code must be selected'; 'Another code must be selected';
TC_INACTIVE_CODE = 'Inactive ICD Code'; TC_INACTIVE_CODE = 'Inactive ICD Code';
TX_PAST_DATE = 'Earliest appropriate date must be today or later.';
TX_BAD_DATES = 'Latest appropriate date must be equal to or later than earliest date.';
function EditResubmitProcedure(FontSize: Integer; ConsultIEN: integer): boolean; function EditResubmitProcedure(FontSize: Integer; ConsultIEN: integer): boolean;
begin begin
@ -164,6 +179,7 @@ procedure TfrmEditProc.InitDialog;
var var
i: integer; i: integer;
begin begin
if FChanging then exit;
FChanging := True; FChanging := True;
Defaults := TStringList.Create; Defaults := TStringList.Create;
FastAssign(ODForProcedures, Defaults); FastAssign(ODForProcedures, Defaults);
@ -198,6 +214,10 @@ begin
cboPlace.SelectByID(OldRec.Place); cboPlace.SelectByID(OldRec.Place);
with cboUrgency do for i := 0 to Items.Count-1 do with cboUrgency do for i := 0 to Items.Count-1 do
if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i; if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i;
calEarliest.FMDateTime := OldRec.EarliestDate;
FEarliestDate := OldRec.EarliestDate;
//calLatest.FMDateTime := OldRec.LatestDate;
//FLatestDate := OldRec.LatestDate;
txtProvDiag.Text := OldRec.ProvDiagnosis; txtProvDiag.Text := OldRec.ProvDiagnosis;
ProvDx.Code := OldRec.ProvDxCode; ProvDx.Code := OldRec.ProvDxCode;
if OldRec.ProvDxCodeInactive then if OldRec.ProvDxCodeInactive then
@ -210,6 +230,15 @@ begin
btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0); btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0);
memComment.Clear ; memComment.Clear ;
SetProvDiagPromptingMode; SetProvDiagPromptingMode;
if (patient.CombatVet.IsEligible = True) then
begin
SetUpCombatVet;
end
else
begin
txtCombatVet.Enabled := False;
pnlCombatVet.SendToBack;
end;
FChanging := False; FChanging := False;
StatusText(''); StatusText('');
end; end;
@ -237,6 +266,9 @@ begin
end; end;
if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
SetError(TX_INACTIVE_CODE); SetError(TX_INACTIVE_CODE);
if calEarliest.FMDateTime < FMToday then SetError(TX_PAST_DATE);
//if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE);
//if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
end; end;
procedure TfrmEditProc.txtAttnNeedData(Sender: TObject; procedure TfrmEditProc.txtAttnNeedData(Sender: TObject;
@ -246,6 +278,20 @@ begin
txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction)); txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
end; end;
procedure TfrmEditProc.calEarliestExit(Sender: TObject);
begin
inherited;
FEarliestDate := calEarliest.FMDateTime;
ControlChange(Self);
end;
procedure TfrmEditProc.calLatestExit(Sender: TObject);
begin
inherited;
//FLatestDate := calLatest.FMDateTime;
//ControlChange(Self);
end;
procedure TfrmEditProc.cboProcNeedData(Sender: TObject; procedure TfrmEditProc.cboProcNeedData(Sender: TObject;
const StartFrom: string; Direction, InsertAt: Integer); const StartFrom: string; Direction, InsertAt: Integer);
begin begin
@ -322,6 +368,21 @@ begin
UrgencyName := ''; UrgencyName := '';
end; end;
if FEarliestDate > 0 then
begin
if FEarliestDate <> OldRec.EarliestDate then
EarliestDate := FEarliestDate
else
EarliestDate := 0;
end;
(* if FLatestDate > 0 then
begin
if FLatestDate <> OldRec.LatestDate then
LatestDate := FLatestDate
else
LatestDate := 0;
end;*)
with cboPlace do if Length(ItemID) > 0 then with cboPlace do if Length(ItemID) > 0 then
if ItemID <> OldRec.Place then if ItemID <> OldRec.Place then
@ -432,6 +493,18 @@ begin
cmdLexSearchClick(Self); cmdLexSearchClick(Self);
end; end;
procedure TfrmEditProc.SetUpCombatVet;
begin
pnlCombatVet.BringToFront;
txtCombatVet.Enabled := True;
txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
pnlMain.Anchors := [akLeft, akTop, akRight];
self.Height := self.Height + pnlCombatVet.Height;
pnlMain.Anchors := [akLeft, akTop, akRight, akBottom];
ActiveControl := txtCombatVet;
end;
procedure TfrmEditProc.cboProcSelect(Sender: TObject); procedure TfrmEditProc.cboProcSelect(Sender: TObject);
begin begin
inherited; inherited;
@ -453,7 +526,7 @@ begin
begin begin
InfoBox('There are no services defined for this procedure.', InfoBox('There are no services defined for this procedure.',
'Information', MB_OK or MB_ICONINFORMATION); 'Information', MB_OK or MB_ICONINFORMATION);
cboProc.ItemIndex := -1; //cboProc.ItemIndex := -1;
InitDialog; InitDialog;
Exit ; Exit ;
end; end;
@ -651,6 +724,25 @@ begin
end; end;
procedure TfrmEditProc.memCommentExit(Sender: TObject);
//added OnExit code for CQ17822 WAT
var
AStringList: TStringList;
begin
inherited;
AStringList := TStringList.Create;
try
//QuickCopy(memComment, AStringList);
AStringList.Text := memComment.Text;
LimitStringLength(AStringList, 74);
//QuickCopy(AstringList, memComment);
memComment.Text := AStringList.Text;
ControlChange(Self);
finally
AStringList.Free;
end;
end;
procedure TfrmEditProc.memCommentKeyUp(Sender: TObject; var Key: Word; procedure TfrmEditProc.memCommentKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
begin begin
@ -670,7 +762,7 @@ end;
procedure TfrmEditProc.memReasonKeyDown(Sender: TObject; var Key: Word; procedure TfrmEditProc.memReasonKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
begin begin
//The navigating tab controls were inadvertantently adding tab characters //The navigating tab controls were inadvertently adding tab characters
//This should fix it //This should fix it
FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []); FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
if FNavigatingTab then if FNavigatingTab then

967
CPRS-Chart/Consults/fODConsult.dfm
View File

File diff suppressed because it is too large Load Diff

237
CPRS-Chart/Consults/fODConsult.pas
View File

@ -8,40 +8,48 @@ uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons, fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet, Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet,
VA508AccessibilityManager ; ORDtTm, VA508AccessibilityManager ;
type type
TfrmODCslt = class(TfrmODBase) TfrmODCslt = class(TfrmODBase)
pnlMain: TPanel;
lblService: TLabel;
lblProvDiag: TLabel;
lblUrgency: TLabel;
lblPlace: TLabel;
lblAttn: TLabel;
lblLatest: TStaticText;
lblEarliest: TStaticText;
pnlReason: TPanel;
lblReason: TLabel;
memReason: TRichEdit;
cboService: TORComboBox; cboService: TORComboBox;
cboUrgency: TORComboBox; cboUrgency: TORComboBox;
cboPlace: TORComboBox; cboPlace: TORComboBox;
txtProvDiag: TCaptionEdit; txtProvDiag: TCaptionEdit;
txtAttn: TORComboBox; txtAttn: TORComboBox;
lblService: TLabel;
lblUrgency: TLabel;
lblPlace: TLabel;
lblAttn: TLabel;
lblProvDiag: TLabel;
treService: TORTreeView; treService: TORTreeView;
cboCategory: TORComboBox; cboCategory: TORComboBox;
pnlServiceTreeButton: TKeyClickPanel; pnlServiceTreeButton: TKeyClickPanel;
btnServiceTree: TSpeedButton; btnServiceTree: TSpeedButton;
gbInptOpt: TGroupBox;
radInpatient: TRadioButton;
radOutpatient: TRadioButton;
btnDiagnosis: TButton;
cmdLexSearch: TButton;
calEarliest: TORDateBox;
calLatest: TORDateBox;
mnuPopProvDx: TPopupMenu; mnuPopProvDx: TPopupMenu;
mnuPopProvDxDelete: TMenuItem; mnuPopProvDxDelete: TMenuItem;
cmdLexSearch: TButton;
popReason: TPopupMenu; popReason: TPopupMenu;
popReasonCut: TMenuItem; popReasonCut: TMenuItem;
popReasonCopy: TMenuItem; popReasonCopy: TMenuItem;
popReasonPaste: TMenuItem; popReasonPaste: TMenuItem;
popReasonPaste2: TMenuItem; popReasonPaste2: TMenuItem;
popReasonReformat: TMenuItem; popReasonReformat: TMenuItem;
gbInptOpt: TGroupBox; pnlCombatVet: TPanel;
radInpatient: TRadioButton; txtCombatVet: TVA508StaticText;
radOutpatient: TRadioButton; servicelbl508: TVA508StaticText;
pnlReason: TPanel;
lblReason: TLabel;
memReason: TRichEdit;
btnDiagnosis: TButton;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer); Direction, InsertAt: Integer);
@ -95,6 +103,7 @@ type
FLastServiceID: string; FLastServiceID: string;
FEditCtrl: TCustomEdit; FEditCtrl: TCustomEdit;
FNavigatingTab: boolean; FNavigatingTab: boolean;
LLS_LINE_INDEX: integer;
procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode); procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode);
procedure ReadServerVariables; procedure ReadServerVariables;
procedure SetProvDiagPromptingMode; procedure SetProvDiagPromptingMode;
@ -106,6 +115,11 @@ type
procedure SaveConsultDxForNurse(pDiagnosis: string); // save the dx entered by nurese if Master BA switch is ON procedure SaveConsultDxForNurse(pDiagnosis: string); // save the dx entered by nurese if Master BA switch is ON
procedure SetUpCopyConsultDiagnoses(pOrderID:string); procedure SetUpCopyConsultDiagnoses(pOrderID:string);
procedure AdjustMemReasonSize; procedure AdjustMemReasonSize;
function NotinIndex(AList: TStringList; i: integer): boolean;
function GetItemIndex(Service: String; Index: integer): integer;
procedure SetUpCombatVet;
procedure SetUpEarliestDate; //wat v28
procedure setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox);
protected protected
procedure InitDialog; override; procedure InitDialog; override;
procedure Validate(var AnErrMsg: string); override; procedure Validate(var AnErrMsg: string); override;
@ -122,13 +136,16 @@ var
consultQuickOrder: boolean; consultQuickOrder: boolean;
function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
implementation implementation
{$R *.DFM} {$R *.DFM}
uses uses
rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq, rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq,
ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility; ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility,
VA508AccessibilityRouter;
var var
SvcList, QuickList, Defaults: TStrings ; SvcList, QuickList, Defaults: TStrings ;
@ -136,7 +153,7 @@ var
GMRCREAF: string; GMRCREAF: string;
BADxUpdated: boolean; BADxUpdated: boolean;
quickCode: string; quickCode: string;
AreGlobalsFree: boolean;
@ -155,11 +172,45 @@ const
TX_INACTIVE_CODE1 = 'The provisional diagnosis code is not active as of today''s date.' + #13#10; TX_INACTIVE_CODE1 = 'The provisional diagnosis code is not active as of today''s date.' + #13#10;
TX_INACTIVE_CODE_REQD = 'Another code must be selected before the order can be saved.'; TX_INACTIVE_CODE_REQD = 'Another code must be selected before the order can be saved.';
TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.'; TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
TX_PAST_DATE = 'Earliest appropriate date must be today or later.';
TX_BAD_DATES = 'Latest appropriate date must be equal to or later than earliest date.';
TX_SVC_HRCHY = 'services/specialties hierarchy'; TX_SVC_HRCHY = 'services/specialties hierarchy';
TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically'; TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically';
TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view'; TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view';
{************** Static Unit Methods ***************}
function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
begin
Result := true;
if (dialog is TfrmODCslt) then
Result := AreGlobalsFree;
end;
procedure InitializeGlobalLists;
begin
Defaults := TStringList.Create;
SvcList := TStringList.Create;
QuickList := TStringList.Create;
AreGlobalsFree := false;
end;
function FreeGlobalLists : Boolean;
begin
Result := false;
if AreGlobalsFree then
Exit;
Defaults.Free;
SvcList.Free;
QuickList.Free;
AreGlobalsFree := true;
Result := true;
end;
{*************** TfrmODCslt Methods ***********}
procedure TfrmODCslt.FormCreate(Sender: TObject); procedure TfrmODCslt.FormCreate(Sender: TObject);
begin begin
frmFrame.pnlVisit.Enabled := false; frmFrame.pnlVisit.Enabled := false;
@ -175,9 +226,7 @@ begin
btnDiagnosis.Visible := False; btnDiagnosis.Visible := False;
cmdLexSearch.Visible := True; cmdLexSearch.Visible := True;
end; end;
Defaults := TStringList.Create ; InitializeGlobalLists;
SvcList := TStringList.Create ;
QuickList := TStringList.Create ;
AllowQuickOrder := True; AllowQuickOrder := True;
LastNode := 0; LastNode := 0;
FLastServiceID := '' ; FLastServiceID := '' ;
@ -189,15 +238,26 @@ begin
StatusText('Loading Default Values'); StatusText('Loading Default Values');
FastAssign(ODForConsults, Defaults); // ODForConsults returns TStrings with defaults FastAssign(ODForConsults, Defaults); // ODForConsults returns TStrings with defaults
CtrlInits.LoadDefaults(Defaults); CtrlInits.LoadDefaults(Defaults);
calEarliest.Text := 'TODAY';
//calLatest.Text := 'TODAY+30';
txtAttn.InitLongList('') ; txtAttn.InitLongList('') ;
PreserveControl(txtAttn); PreserveControl(txtAttn);
PreserveControl(calEarliest);
//PreserveControl(calLatest);
if (patient.CombatVet.IsEligible = True) then
begin
SetUpCombatVet;
end
else
begin
txtCombatVet.Enabled := False;
pnlCombatVet.SendToBack;
end;
InitDialog; InitDialog;
//Calling virtual SetFontSize in constructor is a bad idea! //Calling virtual SetFontSize in constructor is a bad idea!
DoSetFontSize( MainFontSize); DoSetFontSize( MainFontSize);
FcboServiceKeyDownStopClick := false; FcboServiceKeyDownStopClick := false;
consultQuickOrder := false; consultQuickOrder := false;
end; end;
procedure TfrmODCslt.InitDialog; procedure TfrmODCslt.InitDialog;
@ -232,12 +292,14 @@ begin
memOrder.Clear ; memOrder.Clear ;
memReason.Clear; memReason.Clear;
cboService.Enabled := True; cboService.Enabled := True;
setup508Label(servicelbl508, cboService);
cboService.Font.Color := clWindowText; cboService.Font.Color := clWindowText;
cboService.Height := 25 + (7 * cboService.ItemHeight); cboService.Height := 25 + (11 * cboService.ItemHeight);
btnServiceTree.Enabled := True; btnServiceTree.Enabled := True;
pnlServiceTreeButton.Enabled := True; pnlServiceTreeButton.Enabled := True;
SetProvDiagPromptingMode; SetProvDiagPromptingMode;
ActiveControl := cboService; // set after call to SetProvDiagPromptingMode ActiveControl := cboService;
Changing := False; Changing := False;
StatusText(''); StatusText('');
end; end;
@ -257,6 +319,7 @@ var
SvcIEN: string; SvcIEN: string;
begin begin
inherited; inherited;
LLS_LINE_INDEX := -1;
ReadServerVariables; ReadServerVariables;
AList := TStringList.Create; AList := TStringList.Create;
try try
@ -280,6 +343,7 @@ begin
Close; Close;
Exit; Exit;
end; end;
cboService.Items.Add(SvcIEN + U + tmpResp.EValue + '^^^^' + tmpResp.IValue); cboService.Items.Add(SvcIEN + U + tmpResp.EValue + '^^^^' + tmpResp.IValue);
cboService.SelectByID(SvcIEN); cboService.SelectByID(SvcIEN);
tmpResp := TResponse(FindResponseByName('CLASS',1)); tmpResp := TResponse(FindResponseByName('CLASS',1));
@ -288,10 +352,14 @@ begin
radInpatient.Checked := True radInpatient.Checked := True
else else
radOutpatient.Checked := True ; radOutpatient.Checked := True ;
SetControl(cboUrgency, 'URGENCY', 1); SetUpEarliestDate; //wat v28
SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1); SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1); SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
cboService.Enabled := False; cboService.Enabled := False;
setup508Label(servicelbl508, cboService);
cboService.Font.Color := clGrayText; cboService.Font.Color := clGrayText;
btnServiceTree.Enabled := False; btnServiceTree.Enabled := False;
pnlServiceTreeButton.Enabled := False; pnlServiceTreeButton.Enabled := False;
@ -307,6 +375,7 @@ begin
if WasTemplateDialogCanceled then if WasTemplateDialogCanceled then
begin begin
AbortOrder := True; AbortOrder := True;
SetTemplateDialogCanceled(FALSE);
Close; Close;
Exit; Exit;
end; end;
@ -315,6 +384,7 @@ begin
if WasTemplateDialogCanceled then if WasTemplateDialogCanceled then
begin begin
AbortOrder := True; AbortOrder := True;
SetTemplateDialogCanceled(FALSE);
Close; Close;
Exit; Exit;
end; end;
@ -342,11 +412,13 @@ begin
begin begin
FastAssign(QuickList, cboService.Items); FastAssign(QuickList, cboService.Items);
Items.Add(LLS_LINE); Items.Add(LLS_LINE);
LLS_LINE_INDEX := Items.IndexOf(Trim(Piece(LLS_LINE, U, 2))); {TP - HDS00015782: Used to determine if QO}
Items.Add(LLS_SPACE); Items.Add(LLS_SPACE);
end; end;
Changing := True; Changing := True;
for i := 0 to AList.Count - 1 do for i := 0 to AList.Count - 1 do
if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and {RV} //if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and {RV}
if (NotinIndex(AList,i)) and {TP - HDS00015782: Check if service is already in index (not including QO)}
//if (cboService.SelectByID(Piece(AList.Strings[i], U, 1)) = -1) and //if (cboService.SelectByID(Piece(AList.Strings[i], U, 1)) = -1) and
(Piece(AList.Strings[i], U, 5) <> '1') then (Piece(AList.Strings[i], U, 5) <> '1') then
cboService.Items.Add(AList.Strings[i]); cboService.Items.Add(AList.Strings[i]);
@ -409,6 +481,9 @@ begin
else else
SetError(TX_SELECT_DIAG); SetError(TX_SELECT_DIAG);
end; end;
if (lblEarliest.Enabled) and (calEarliest.FMDateTime < FMToday) then SetError(TX_PAST_DATE);
//if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE);
//if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
end; end;
procedure TfrmODCslt.txtAttnNeedData(Sender: TObject; procedure TfrmODCslt.txtAttnNeedData(Sender: TObject;
@ -547,6 +622,7 @@ begin
cboService.ItemIndex := -1; cboService.ItemIndex := -1;
FLastServiceID := ItemID; FLastServiceID := ItemID;
cboService.Enabled := False; cboService.Enabled := False;
setup508Label(servicelbl508, cboService);
cboService.Font.Color := clGrayText; cboService.Font.Color := clGrayText;
btnServiceTree.Enabled := False; btnServiceTree.Enabled := False;
pnlServiceTreeButton.Enabled := False; pnlServiceTreeButton.Enabled := False;
@ -587,11 +663,14 @@ begin
SetControl(cboUrgency, 'URGENCY', 1); SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1); SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1); SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
SetTemplateDialogCanceled(FALSE); SetTemplateDialogCanceled(FALSE);
SetControl(memReason, 'COMMENT', 1); SetControl(memReason, 'COMMENT', 1);
if WasTemplateDialogCanceled and OrderContainsObjects then if WasTemplateDialogCanceled and OrderContainsObjects then
begin begin
AbortOrder := TRUE; AbortOrder := TRUE;
SetTemplateDialogCanceled(FALSE);
Close; Close;
Exit; Exit;
end; end;
@ -615,6 +694,7 @@ begin
end; end;
end; end;
SetProvDiagPromptingMode; SetProvDiagPromptingMode;
SetUpEarliestDate; //wat v28
tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6); tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6);
pnlMessage.TabOrder := treService.TabOrder + 1; pnlMessage.TabOrder := treService.TabOrder + 1;
OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0))); OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0)));
@ -645,11 +725,13 @@ begin
end end
else Responses.Update('ORDERABLE', 1, '', ''); else Responses.Update('ORDERABLE', 1, '', '');
end; end;
with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text); with memReason do Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
with cboCategory do if ItemID <> '' then Responses.Update('CLASS', 1, ItemID, Text); with cboCategory do Responses.Update('CLASS', 1, ItemID, Text);
with cboUrgency do if ItemIEN > 0 then Responses.Update('URGENCY', 1, ItemID, Text); with cboUrgency do Responses.Update('URGENCY', 1, ItemID, Text);
with cboPlace do if ItemID <> '' then Responses.Update('PLACE', 1, ItemID, Text); with cboPlace do Responses.Update('PLACE', 1, ItemID, Text);
with txtAttn do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text); with txtAttn do Responses.Update('PROVIDER', 1, ItemID, Text);
with calEarliest do if Length(Text) > 0 then Responses.Update('EARLIEST', 1, Text, Text);
//with calLatest do if Length(Text) > 0 then Responses.Update('LATEST', 1, Text, Text);
//with txtProvDiag do if Length(Text) > 0 then Responses.Update('MISC', 1, Text, Text); //with txtProvDiag do if Length(Text) > 0 then Responses.Update('MISC', 1, Text, Text);
if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text) if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text)
else Responses.Update('MISC', 1, '', ''); else Responses.Update('MISC', 1, '', '');
@ -757,6 +839,7 @@ begin
memReason.Clear; memReason.Clear;
with cboService do with cboService do
begin begin
setup508Label(servicelbl508, cboService);
if (ItemIndex < 0) or (ItemID = '') then if (ItemIndex < 0) or (ItemID = '') then
begin begin
Responses.Update('ORDERABLE', 1, '', ''); Responses.Update('ORDERABLE', 1, '', '');
@ -778,9 +861,11 @@ begin
begin begin
Changing := True; Changing := True;
Responses.QuickOrder := ExtractInteger(ItemID); Responses.QuickOrder := ExtractInteger(ItemID);
consultQuickOrder := True; consultQuickOrder := True;
tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).EValue; tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).EValue;
ItemIndex := Items.IndexOf(Trim(tmpSvc)); ItemIndex := Items.IndexOf(Trim(tmpSvc));
If ItemIndex < LLS_LINE_INDEX then {TP - HDS00015782: Check if index is of a QO}
ItemIndex := GetItemIndex(tmpSvc,ItemIndex);
(* tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue; (* tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
for i := 0 to Items.Count-1 do for i := 0 to Items.Count-1 do
begin begin
@ -792,6 +877,7 @@ begin
end;*) end;*)
FLastServiceID := ItemID; FLastServiceID := ItemID;
Enabled := False; Enabled := False;
setup508Label(servicelbl508, cboService);
Font.Color := clGrayText; Font.Color := clGrayText;
btnServiceTree.Enabled := False; btnServiceTree.Enabled := False;
pnlServiceTreeButton.Enabled := False; pnlServiceTreeButton.Enabled := False;
@ -810,11 +896,14 @@ begin
SetControl(cboUrgency, 'URGENCY', 1); SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1); SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1); SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
SetTemplateDialogCanceled(FALSE); SetTemplateDialogCanceled(FALSE);
SetControl(memReason, 'COMMENT', 1); SetControl(memReason, 'COMMENT', 1);
if WasTemplateDialogCanceled and OrderContainsObjects then if WasTemplateDialogCanceled and OrderContainsObjects then
begin begin
AbortOrder := TRUE; AbortOrder := TRUE;
SetTemplateDialogCanceled(FALSE);
Close; Close;
Exit; Exit;
end; end;
@ -860,13 +949,14 @@ begin
OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0))); OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0)));
//OrderMessage(ConsultMessage(cboService.ItemIEN)); //OrderMessage(ConsultMessage(cboService.ItemIEN));
ControlChange(Self) ; ControlChange(Self) ;
SetUpEarliestDate; //wat v28
setup508Label(servicelbl508, cboService);
end; end;
procedure TfrmODCslt.FormDestroy(Sender: TObject); procedure TfrmODCslt.FormDestroy(Sender: TObject);
begin begin
Defaults.Free; if not FreeGlobalLists then
SvcList.Free ; Exit;
QuickList.Free;
inherited; inherited;
end; end;
@ -985,7 +1075,6 @@ begin
if ProvDx.Text[i-1] = '*' then i := i - 2; if ProvDx.Text[i-1] = '*' then i := i - 2;
ProvDx.Text := Copy(ProvDx.Text, 1, i - 1); ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')'; txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
ProvDx.CodeInactive := False; ProvDx.CodeInactive := False;
end; end;
@ -1056,6 +1145,17 @@ begin
end; end;
procedure TfrmODCslt.setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox);
begin
if ScreenReaderSystemActive and not ctrl.Enabled then begin
lbl.Enabled := True;
lbl.Visible := True;
lbl.Caption := lblService.Caption + ', ' + ctrl.Text;
lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left;
end else
lbl.Visible := false;
end;
procedure TfrmODCslt.mnuPopProvDxDeleteClick(Sender: TObject); procedure TfrmODCslt.mnuPopProvDxDeleteClick(Sender: TObject);
begin begin
inherited; inherited;
@ -1492,6 +1592,73 @@ const
begin begin
pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE; pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE;
pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE; pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE;
if patient.CombatVet.IsEligible then pnlReason.Height := pnlReason.Height - PIXEL_SPACE*20;
end;
function TfrmODCslt.NotinIndex(AList: TStringList; i: integer): Boolean; {TP - HDS00015782:}
{This function determines if a Consult Service will be added to the cboService
component. If name does not exist or if name does not exist below the Quick
Order listing, then it is added.}
var
x: Integer;
y: String;
begin
Result := False;
x := cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2)));
if (x = -1) then
Result := True;
if (x <> -1) and (x < LLS_LINE_INDEX) then
begin
y := cboService.Items[x];
cboService.Items.Delete(x);
if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) then
Result := True;
cboService.Items.Insert(x,y);
end;
end;
function TfrmODCslt.GetItemIndex(Service: String; Index: integer): integer; {TP - HDS00015782:}
{This function returns ItemIndexOf value for Service Consult when a Quick Order
has the exact same name}
var
y: String;
begin
y := cboService.Items[Index];
cboService.Items.Delete(Index);
Result := (cboService.Items.IndexOf(Trim(Service)) + 1);
cboService.Items.Insert(Index,y);
end;
procedure TfrmODCslt.SetUpCombatVet;
begin
pnlCombatVet.BringToFront;
txtCombatVet.Enabled := True;
txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
pnlMain.Anchors := [akLeft,akTop,akRight];
treService.Anchors := [akLeft,akTop,akRight];
self.Height := self.Height + pnlCombatVet.Height;
treService.Anchors := [akLeft,akTop,akRight,akBottom];
pnlMain.Anchors := [akLeft,akTop,akRight,akBottom];
end;
procedure TfrmODCslt.SetUpEarliestDate; //wat v28
begin
if IsProstheticsService(cboService.ItemIEN) = '1' then
begin
lblEarliest.Enabled := False;
calEarliest.Enabled := False;
calEarliest.Text := '';
Responses.Update('EARLIEST',1,'','');
end
else
begin
lblEarliest.Enabled := True;
calEarliest.Enabled := True;
calEarliest.Text := 'TODAY';
end;
end; end;
end. end.

769
CPRS-Chart/Consults/fODProc.dfm
View File

@ -1,360 +1,459 @@
inherited frmODProc: TfrmODProc inherited frmODProc: TfrmODProc
Tag = 112 Tag = 112
Left = 208 Left = 430
Top = 188 Top = 203
Width = 543 Width = 606
Height = 393 Height = 442
HorzScrollBar.Range = 523 HorzScrollBar.Range = 523
VertScrollBar.Range = 295 VertScrollBar.Range = 295
Anchors = [akLeft, akTop, akRight, akBottom]
Caption = 'Order a Procedure' Caption = 'Order a Procedure'
Constraints.MinHeight = 393 Constraints.MinHeight = 442
Constraints.MinWidth = 543 Constraints.MinWidth = 606
ExplicitLeft = 208 Position = poDesigned
ExplicitTop = 188 OnShow = FormShow
ExplicitWidth = 543 ExplicitWidth = 606
ExplicitHeight = 393 ExplicitHeight = 442
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblProc: TLabel [0] object pnlCombatVet: TPanel [0]
Left = 4
Top = 4
Width = 49
Height = 13
Caption = 'Procedure'
end
object lblService: TOROffsetLabel [1]
Left = 4
Top = 42
Width = 158
Height = 15
Caption = 'Service to perform this procedure'
HorzOffset = 2
Transparent = False
VertOffset = 2
WordWrap = False
end
object lblReason: TLabel [2]
Left = 4
Top = 103
Width = 95
Height = 13
Caption = 'Reason for Request'
end
object lblUrgency: TStaticText [3]
Left = 249
Top = 4
Width = 44
Height = 17
Anchors = [akTop, akRight]
Caption = 'Urgency'
TabOrder = 15
end
object lblPlace: TStaticText [4]
Left = 396
Top = 43
Width = 104
Height = 17
Anchors = [akTop, akRight]
Caption = 'Place of Consultation'
TabOrder = 16
end
object lblAttn: TStaticText [5]
Left = 396
Top = 4
Width = 46
Height = 17
Anchors = [akTop, akRight]
Caption = 'Attention'
TabOrder = 17
end
object lblProvDiag: TStaticText [6]
Left = 249
Top = 81
Width = 104
Height = 17
Anchors = [akTop, akRight]
Caption = 'Provisional Diagnosis'
TabOrder = 18
end
object pnlReason: TPanel [7]
Left = 0 Left = 0
Top = 120 Top = 0
Width = 528 Width = 598
Height = 192 Height = 25
Anchors = [akLeft, akTop, akRight, akBottom] Align = alTop
BevelOuter = bvNone BevelOuter = bvLowered
TabOrder = 9 Font.Charset = DEFAULT_CHARSET
object memReason: TCaptionRichEdit Font.Color = clWindowText
Left = 0 Font.Height = -11
Top = 0 Font.Name = 'MS Sans Serif'
Width = 528 Font.Style = []
Height = 192 ParentFont = False
TabOrder = 0
object txtCombatVet: TVA508StaticText
Name = 'txtCombatVet'
Left = 1
Top = 1
Width = 596
Height = 23
Align = alClient Align = alClient
Font.Charset = DEFAULT_CHARSET Alignment = taCenter
Font.Color = clWindowText BevelOuter = bvNone
Font.Height = -11 Enabled = False
Font.Name = 'Courier New'
Font.Style = []
Constraints.MinHeight = 40
ParentFont = False
PopupMenu = popReason
ScrollBars = ssBoth
TabOrder = 0 TabOrder = 0
WantTabs = True ShowAccelChar = True
OnChange = ControlChange
OnExit = memReasonExit
OnKeyDown = memReasonKeyDown
OnKeyPress = memReasonKeyPress
OnKeyUp = memReasonKeyUp
Caption = 'Reason for Request'
end end
end end
inherited memOrder: TCaptionMemo inherited memOrder: TCaptionMemo
Left = 0 Left = 0
Top = 321 Top = 365
Width = 380 Width = 380
Height = 41 Height = 41
Anchors = [akLeft, akRight] Anchors = [akLeft, akRight, akBottom]
Lines.Strings = ( Lines.Strings = (
'The order text...' 'The order text...'
'----------------------------------------------------------------' + '----------------------------------------------------------------' +
'--------------' '--------------'
'An order message may be displayed here.') 'An order message may be displayed here.')
TabOrder = 1 ParentFont = False
TabOrder = 3
ExplicitLeft = 0 ExplicitLeft = 0
ExplicitTop = 321 ExplicitTop = 365
ExplicitWidth = 380 ExplicitWidth = 380
ExplicitHeight = 41 ExplicitHeight = 41
end end
object cboUrgency: TORComboBox [9] object pnlMain: TPanel [2]
Left = 249 Left = 0
Top = 17 Top = 0
Width = 133 Width = 598
Height = 21 Height = 354
Anchors = [akTop, akRight] Anchors = [akLeft, akTop, akRight, akBottom]
Style = orcsDropDown BevelOuter = bvNone
AutoSelect = True TabOrder = 1
Caption = 'Urgency' DesignSize = (
Color = clWindow 598
DropDownCount = 8 354)
ItemHeight = 13 object lblProc: TLabel
ItemTipColor = clWindow Left = 4
ItemTipEnable = True Top = 4
ListItemsOnly = True Width = 49
LongList = False Height = 13
LookupPiece = 0 Caption = 'Procedure'
MaxLength = 0 end
Pieces = '2' object lblService: TOROffsetLabel
Sorted = False Left = 4
SynonymChars = '<>' Top = 114
TabOrder = 2 Width = 158
OnChange = ControlChange Height = 15
CharsNeedMatch = 1 Caption = 'Service to perform this procedure'
end HorzOffset = 2
object cboPlace: TORComboBox [10] Transparent = False
Left = 396 VertOffset = 2
Top = 56 WordWrap = False
Width = 133 end
Height = 21 object lblReason: TLabel
Anchors = [akTop, akRight] Left = 8
Style = orcsDropDown Top = 165
AutoSelect = True Width = 95
Caption = 'Place of Consultation' Height = 13
Color = clWindow Margins.Left = 0
DropDownCount = 8 Caption = 'Reason for Request'
ItemHeight = 13 end
ItemTipColor = clWindow object lblUrgency: TStaticText
ItemTipEnable = True Left = 312
ListItemsOnly = True Top = 4
LongList = False Width = 44
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 6
OnChange = ControlChange
CharsNeedMatch = 1
end
object txtAttn: TORComboBox [11]
Left = 396
Top = 17
Width = 133
Height = 21
Anchors = [akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Attention'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 2
MaxLength = 0
Pieces = '2,3'
Sorted = False
SynonymChars = '<>'
TabOrder = 3
OnChange = ControlChange
OnNeedData = txtAttnNeedData
CharsNeedMatch = 1
end
object cboProc: TORComboBox [12]
Left = 4
Top = 17
Width = 227
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Procedure'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 0
OnChange = cboProcSelect
OnNeedData = cboProcNeedData
CharsNeedMatch = 1
end
object cboCategory: TORComboBox [13]
Left = 516
Top = 10
Width = 3
Height = 21
Style = orcsDropDown
AutoSelect = True
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
Sorted = False
SynonymChars = '<>'
TabOrder = 13
Visible = False
OnChange = ControlChange
CharsNeedMatch = 1
end
object cboService: TORComboBox [14]
Left = 4
Top = 58
Width = 227
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Service to perform this procedure'
Color = clWindow
DropDownCount = 8
Enabled = False
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 4
OnChange = cboServiceChange
CharsNeedMatch = 1
end
object cmdLexSearch: TButton [15]
Left = 486
Top = 93
Width = 49
Height = 21
Anchors = [akTop, akRight]
Caption = 'Lexicon'
TabOrder = 8
OnClick = cmdLexSearchClick
end
object gbInptOpt: TGroupBox [16]
Left = 249
Top = 36
Width = 140
Height = 45
Anchors = [akTop, akRight]
Caption = 'Patient will be seen as an:'
TabOrder = 5
object radInpatient: TRadioButton
Left = 3
Top = 20
Width = 61
Height = 17 Height = 17
Caption = '&Inpatient' Anchors = [akTop, akRight]
Caption = 'Urgency'
TabOrder = 13
end
object lblPlace: TStaticText
Left = 460
Top = 92
Width = 104
Height = 17
Anchors = [akTop, akRight]
Caption = 'Place of Consultation'
TabOrder = 14
end
object lblAttn: TStaticText
Left = 460
Top = 4
Width = 46
Height = 17
Anchors = [akTop, akRight]
Caption = 'Attention'
TabOrder = 15
end
object lblProvDiag: TStaticText
Left = 312
Top = 135
Width = 104
Height = 17
Anchors = [akTop, akRight]
Caption = 'Provisional Diagnosis'
TabOrder = 16
end
object pnlReason: TPanel
Left = 0
Top = 184
Width = 591
Height = 166
Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone
TabOrder = 11
object memReason: TCaptionRichEdit
Left = 0
Top = 0
Width = 591
Height = 166
Align = alClient
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
Constraints.MinHeight = 40
ParentFont = False
PopupMenu = popReason
ScrollBars = ssBoth
TabOrder = 0
WantTabs = True
OnChange = ControlChange
OnExit = memReasonExit
OnKeyDown = memReasonKeyDown
OnKeyPress = memReasonKeyPress
OnKeyUp = memReasonKeyUp
Caption = 'Reason for Request'
end
end
object cboUrgency: TORComboBox
Left = 312
Top = 17
Width = 133
Height = 21
Anchors = [akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Urgency'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 3
OnChange = ControlChange
CharsNeedMatch = 1
end
object cboPlace: TORComboBox
Left = 460
Top = 105
Width = 133
Height = 21
Anchors = [akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Place of Consultation'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 8
OnChange = ControlChange
CharsNeedMatch = 1
end
object txtAttn: TORComboBox
Left = 460
Top = 17
Width = 131
Height = 21
Anchors = [akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Attention'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 2
MaxLength = 0
Pieces = '2,3'
Sorted = False
SynonymChars = '<>'
TabOrder = 4
OnChange = ControlChange
OnNeedData = txtAttnNeedData
CharsNeedMatch = 1
end
object cboProc: TORComboBox
Left = 4
Top = 17
Width = 290
Height = 91
Anchors = [akLeft, akTop, akRight]
Style = orcsSimple
AutoSelect = True
Caption = 'Procedure'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = True
LongList = True
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 0 TabOrder = 0
OnClick = radInpatientClick OnChange = cboProcSelect
OnNeedData = cboProcNeedData
CharsNeedMatch = 1
end end
object radOutpatient: TRadioButton object cboCategory: TORComboBox
Left = 67 Left = 516
Top = 20 Top = 10
Width = 71 Width = 3
Height = 17 Height = 21
Caption = '&Outpatient' Style = orcsDropDown
AutoSelect = True
Color = clWindow
DropDownCount = 8
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
Sorted = False
SynonymChars = '<>'
TabOrder = 12
Visible = False
OnChange = ControlChange
CharsNeedMatch = 1
end
object cboService: TORComboBox
Left = 4
Top = 130
Width = 290
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Service to perform this procedure'
Color = clWindow
DropDownCount = 8
Enabled = False
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
ListItemsOnly = False
LongList = False
LookupPiece = 0
MaxLength = 0
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 1 TabOrder = 1
OnClick = radOutpatientClick OnChange = cboServiceChange
CharsNeedMatch = 1
end
object cmdLexSearch: TButton
Left = 549
Top = 149
Width = 49
Height = 21
Anchors = [akTop, akRight]
Caption = 'Lexicon'
TabOrder = 10
OnClick = cmdLexSearchClick
end
object gbInptOpt: TGroupBox
Left = 312
Top = 85
Width = 140
Height = 45
Anchors = [akTop, akRight]
Caption = 'Patient will be seen as an:'
TabOrder = 7
object radInpatient: TRadioButton
Left = 3
Top = 20
Width = 61
Height = 17
Caption = '&Inpatient'
TabOrder = 1
OnClick = radInpatientClick
end
object radOutpatient: TRadioButton
Left = 67
Top = 20
Width = 71
Height = 17
Caption = '&Outpatient'
TabOrder = 0
OnClick = radOutpatientClick
end
end
object txtProvDiag: TCaptionEdit
Left = 312
Top = 149
Width = 234
Height = 21
Anchors = [akTop, akRight]
MaxLength = 180
ParentShowHint = False
PopupMenu = mnuPopProvDx
ShowHint = True
TabOrder = 9
OnChange = txtProvDiagChange
Caption = 'Provisional Diagnosis'
end
object lblEarliest: TStaticText
Left = 312
Top = 44
Width = 121
Height = 17
Anchors = [akTop, akRight]
Caption = 'Earliest appropriate date:'
TabOrder = 18
end
object calEarliest: TORDateBox
Left = 312
Top = 58
Width = 133
Height = 21
Anchors = [akTop, akRight]
TabOrder = 5
OnChange = ControlChange
DateOnly = True
RequireTime = False
end
object lblLatest: TStaticText
Left = 460
Top = 44
Width = 116
Height = 17
Anchors = [akTop, akRight]
Caption = 'Latest appropriate date:'
TabOrder = 19
Visible = False
end
object calLatest: TORDateBox
Left = 460
Top = 58
Width = 131
Height = 21
Anchors = [akTop, akRight]
TabOrder = 6
Visible = False
OnChange = ControlChange
DateOnly = True
RequireTime = False
end
object servicelbl508: TVA508StaticText
Name = 'servicelbl508'
Left = 183
Top = 114
Width = 106
Height = 15
Alignment = taLeftJustify
Caption = 'service (for screen R.)'
Enabled = False
TabOrder = 2
Visible = False
ShowAccelChar = True
end end
end
object txtProvDiag: TCaptionEdit [17]
Left = 249
Top = 93
Width = 234
Height = 21
Anchors = [akTop, akRight]
MaxLength = 180
ParentShowHint = False
PopupMenu = mnuPopProvDx
ShowHint = True
TabOrder = 7
OnChange = txtProvDiagChange
Caption = 'Provisional Diagnosis'
end end
inherited cmdAccept: TButton inherited cmdAccept: TButton
Left = 387 Left = 427
Top = 339 Top = 382
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
TabOrder = 10 TabOrder = 4
ExplicitLeft = 387 ExplicitLeft = 427
ExplicitTop = 339 ExplicitTop = 382
end end
inherited cmdQuit: TButton inherited cmdQuit: TButton
Left = 469 Left = 526
Top = 339 Top = 382
Width = 64 Width = 64
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
TabOrder = 11 TabOrder = 5
ExplicitLeft = 469 ExplicitLeft = 526
ExplicitTop = 339 ExplicitTop = 382
ExplicitWidth = 64 ExplicitWidth = 64
end end
inherited pnlMessage: TPanel inherited pnlMessage: TPanel
Left = 50 Left = 13
Top = 320 Top = 361
Width = 316 Width = 316
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
TabOrder = 12 TabOrder = 2
ExplicitLeft = 50 ExplicitLeft = 13
ExplicitTop = 320 ExplicitTop = 361
ExplicitWidth = 316 ExplicitWidth = 316
inherited memMessage: TRichEdit inherited memMessage: TRichEdit
Width = 254 Width = 254
@ -363,6 +462,30 @@ inherited frmODProc: TfrmODProc
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
(
'Component = memOrder'
'Status = stsDefault')
(
'Component = cmdAccept'
'Status = stsDefault')
(
'Component = cmdQuit'
'Status = stsDefault')
(
'Component = pnlMessage'
'Status = stsDefault')
(
'Component = memMessage'
'Status = stsDefault')
(
'Component = frmODProc'
'Status = stsDefault')
(
'Component = pnlMain'
'Status = stsDefault')
(
'Component = pnlCombatVet'
'Status = stsDefault')
( (
'Component = lblUrgency' 'Component = lblUrgency'
'Status = stsDefault') 'Status = stsDefault')
@ -415,27 +538,27 @@ inherited frmODProc: TfrmODProc
'Component = txtProvDiag' 'Component = txtProvDiag'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = memOrder' 'Component = lblEarliest'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = cmdAccept' 'Component = calEarliest'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = cmdQuit' 'Component = lblLatest'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = pnlMessage' 'Component = calLatest'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = memMessage' 'Component = txtCombatVet'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = frmODProc' 'Component = servicelbl508'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object mnuPopProvDx: TPopupMenu object mnuPopProvDx: TPopupMenu
Left = 353 Left = 353
Top = 77 Top = 133
object mnuPopProvDxDelete: TMenuItem object mnuPopProvDxDelete: TMenuItem
Caption = 'Delete diagnosis' Caption = 'Delete diagnosis'
OnClick = mnuPopProvDxDeleteClick OnClick = mnuPopProvDxDeleteClick
@ -443,8 +566,8 @@ inherited frmODProc: TfrmODProc
end end
object popReason: TPopupMenu object popReason: TPopupMenu
OnPopup = popReasonPopup OnPopup = popReasonPopup
Left = 411 Left = 483
Top = 169 Top = 337
object popReasonCut: TMenuItem object popReasonCut: TMenuItem
Caption = 'Cu&t' Caption = 'Cu&t'
ShortCut = 16472 ShortCut = 16472

153
CPRS-Chart/Consults/fODProc.pas
View File

@ -5,38 +5,46 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons, fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
Menus, VA508AccessibilityManager; Menus, ORDtTm, VA508AccessibilityManager;
type type
TfrmODProc = class(TfrmODBase) TfrmODProc = class(TfrmODBase)
cboUrgency: TORComboBox; pnlMain: TPanel;
cboPlace: TORComboBox; pnlCombatVet: TPanel;
txtAttn: TORComboBox;
lblProc: TLabel; lblProc: TLabel;
cboProc: TORComboBox; lblService: TOROffsetLabel;
lblReason: TLabel;
lblUrgency: TStaticText; lblUrgency: TStaticText;
lblPlace: TStaticText; lblPlace: TStaticText;
lblAttn: TStaticText; lblAttn: TStaticText;
lblProvDiag: TStaticText; lblProvDiag: TStaticText;
pnlReason: TPanel;
memReason: TCaptionRichEdit;
cboUrgency: TORComboBox;
cboPlace: TORComboBox;
txtAttn: TORComboBox;
cboProc: TORComboBox;
cboCategory: TORComboBox; cboCategory: TORComboBox;
cboService: TORComboBox; cboService: TORComboBox;
lblService: TOROffsetLabel; cmdLexSearch: TButton;
gbInptOpt: TGroupBox;
radInpatient: TRadioButton;
radOutpatient: TRadioButton;
txtProvDiag: TCaptionEdit;
lblEarliest: TStaticText;
calEarliest: TORDateBox;
lblLatest: TStaticText;
calLatest: TORDateBox;
mnuPopProvDx: TPopupMenu; mnuPopProvDx: TPopupMenu;
mnuPopProvDxDelete: TMenuItem; mnuPopProvDxDelete: TMenuItem;
cmdLexSearch: TButton;
popReason: TPopupMenu; popReason: TPopupMenu;
popReasonCut: TMenuItem; popReasonCut: TMenuItem;
popReasonCopy: TMenuItem; popReasonCopy: TMenuItem;
popReasonPaste: TMenuItem; popReasonPaste: TMenuItem;
popReasonPaste2: TMenuItem; popReasonPaste2: TMenuItem;
popReasonReformat: TMenuItem; popReasonReformat: TMenuItem;
pnlReason: TPanel; txtCombatVet: TVA508StaticText;
memReason: TCaptionRichEdit; servicelbl508: TVA508StaticText;
gbInptOpt: TGroupBox;
radInpatient: TRadioButton;
radOutpatient: TRadioButton;
txtProvDiag: TCaptionEdit;
lblReason: TLabel;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer); Direction, InsertAt: Integer);
@ -63,6 +71,7 @@ type
procedure memReasonKeyPress(Sender: TObject; var Key: Char); procedure memReasonKeyPress(Sender: TObject; var Key: Char);
procedure FormResize(Sender: TObject); procedure FormResize(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
private private
FLastProcID: string; FLastProcID: string;
FEditCtrl: TCustomEdit; FEditCtrl: TCustomEdit;
@ -73,6 +82,9 @@ type
procedure GetProvDxandValidateCode(AResponses: TResponses); procedure GetProvDxandValidateCode(AResponses: TResponses);
function ShowPrerequisites: boolean; function ShowPrerequisites: boolean;
procedure DoSetFontSize( FontSize: integer); procedure DoSetFontSize( FontSize: integer);
procedure SetUpCombatVet;
procedure updateService;
procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
protected protected
procedure InitDialog; override; procedure InitDialog; override;
procedure Validate(var AnErrMsg: string); override; procedure Validate(var AnErrMsg: string); override;
@ -82,18 +94,23 @@ type
procedure SetFontSize( FontSize: integer); override; procedure SetFontSize( FontSize: integer); override;
end; end;
function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
implementation implementation
{$R *.DFM} {$R *.DFM}
uses uses
rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses, rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses,
clipbrd, fPreReq, uTemplates, fFrame, uODBase, clipbrd, fPreReq, uTemplates, fFrame, uODBase, VA508AccessibilityRouter,
uVA508CPRSCompatibility; uVA508CPRSCompatibility;
var var
ProvDx: TProvisionalDiagnosis; ProvDx: TProvisionalDiagnosis;
GMRCREAF: string; GMRCREAF: string;
OkToFreeProcDialog: boolean;
const const
TX_NO_PROC = 'A procedure must be specified.' ; TX_NO_PROC = 'A procedure must be specified.' ;
@ -107,12 +124,26 @@ const
TX_INACTIVE_CODE1 = 'The provisional diagnosis code is not active as of today''s date.' + #13#10; TX_INACTIVE_CODE1 = 'The provisional diagnosis code is not active as of today''s date.' + #13#10;
TX_INACTIVE_CODE_REQD = 'Another code must be selected before the order can be saved.'; TX_INACTIVE_CODE_REQD = 'Another code must be selected before the order can be saved.';
TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.'; TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
TX_PAST_DATE = 'Earliest appropriate date must be today or later.';
TX_BAD_DATES = 'Latest appropriate date must be equal to or later than earliest date.';
{ ********* Static Unit Methods ************ }
function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
begin
Result := true;
if (dialog is TfrmODProc) then
Result := OkToFreeProcDialog;
end;
{ ********************* TfrmODProc Methods **************** }
procedure TfrmODProc.FormCreate(Sender: TObject); procedure TfrmODProc.FormCreate(Sender: TObject);
begin begin
frmFrame.pnlVisit.Enabled := false; frmFrame.pnlVisit.Enabled := false;
AutoSizeDisabled := True; AutoSizeDisabled := True;
inherited; inherited;
OkToFreeProcDialog := False;
DoSetFontSize(MainFontSize); DoSetFontSize(MainFontSize);
AllowQuickOrder := True; AllowQuickOrder := True;
FillChar(ProvDx, SizeOf(ProvDx), 0); FillChar(ProvDx, SizeOf(ProvDx), 0);
@ -125,8 +156,21 @@ begin
ReadServerVariables; ReadServerVariables;
cboProc.InitLongList('') ; cboProc.InitLongList('') ;
txtAttn.InitLongList('') ; txtAttn.InitLongList('') ;
calEarliest.Text := 'TODAY';
//calLatest.Text := 'TODAY+30';
PreserveControl(calEarliest);
//PreserveControl(calLatest);
PreserveControl(txtAttn); PreserveControl(txtAttn);
PreserveControl(cboProc); PreserveControl(cboProc);
if (patient.CombatVet.IsEligible = True) then
begin
SetUpCombatVet;
end
else
begin
txtCombatVet.Enabled := False;
pnlCombatVet.SendToBack;
end;
InitDialog; InitDialog;
end; end;
@ -197,6 +241,8 @@ begin
SetControl(cboUrgency, 'URGENCY', 1); SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1); SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1); SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
cboProc.Enabled := False; cboProc.Enabled := False;
cboProc.Font.Color := clGrayText; cboProc.Font.Color := clGrayText;
//SetControl(cboService, 'SERVICE', 1); // to fix OR*3.0*95 bug in v17.6 (RV) //SetControl(cboService, 'SERVICE', 1); // to fix OR*3.0*95 bug in v17.6 (RV)
@ -228,7 +274,9 @@ begin
SetControl(memReason, 'COMMENT', 1); SetControl(memReason, 'COMMENT', 1);
if WasTemplateDialogCanceled then if WasTemplateDialogCanceled then
begin begin
AbortOrder := True; AbortOrder := True;
OkToFreeProcDialog := true;
SetTemplateDialogCanceled(FALSE);
Close; Close;
Exit; Exit;
end; end;
@ -237,6 +285,8 @@ begin
if WasTemplateDialogCanceled then if WasTemplateDialogCanceled then
begin begin
AbortOrder := True; AbortOrder := True;
OkToFreeProcDialog := true;
SetTemplateDialogCanceled(FALSE);
Close; Close;
Exit; Exit;
end; end;
@ -257,18 +307,21 @@ procedure TfrmODProc.Validate(var AnErrMsg: string);
begin begin
inherited; inherited;
if cboProc.ItemIEN = 0 then SetError(TX_NO_PROC); if cboProc.ItemIEN = 0 then SetError(TX_NO_PROC);
if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY); if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
if cboPlace.ItemID = '' then SetError(TX_NO_PLACE); if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
if (not ContainsVisibleChar(memReason.Text)) if (not ContainsVisibleChar(memReason.Text))
then SetError(TX_NO_REASON); then SetError(TX_NO_REASON);
if cboService.ItemIEN = 0 then SetError(TX_NO_SERVICE); if cboService.ItemIEN = 0 then SetError(TX_NO_SERVICE);
if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
begin begin
if ProvDx.PromptMode = 'F' then if ProvDx.PromptMode = 'F' then
SetError(TX_NO_DIAG) SetError(TX_NO_DIAG)
else else
SetError(TX_SELECT_DIAG); SetError(TX_SELECT_DIAG);
end; end;
if calEarliest.FMDateTime < FMToday then SetError(TX_PAST_DATE);
//if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE);
//if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
end; end;
procedure TfrmODProc.txtAttnNeedData(Sender: TObject; procedure TfrmODProc.txtAttnNeedData(Sender: TObject;
@ -336,15 +389,14 @@ begin
end end
else Responses.Update('ORDERABLE', 1, '', ''); else Responses.Update('ORDERABLE', 1, '', '');
end; end;
(* with cboProc do if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text) updateService();
else Responses.Update('ORDERABLE', 1, '', '');*)
with cboService do if ItemIEN > 0 then Responses.Update('SERVICE', 1, ItemID, Text)
else Responses.Update('SERVICE', 1, '', '');
with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text); with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
with cboCategory do if ItemID <> '' then Responses.Update('CLASS', 1, ItemID, Text); with cboCategory do if ItemID <> '' then Responses.Update('CLASS', 1, ItemID, Text);
with cboUrgency do if ItemIEN > 0 then Responses.Update('URGENCY', 1, ItemID, Text); with cboUrgency do if ItemIEN > 0 then Responses.Update('URGENCY', 1, ItemID, Text);
with cboPlace do if ItemID <> '' then Responses.Update('PLACE', 1, ItemID, Text); with cboPlace do if ItemID <> '' then Responses.Update('PLACE', 1, ItemID, Text);
with txtAttn do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text); with txtAttn do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text);
with calEarliest do if Length(Text) > 0 then Responses.Update('EARLIEST', 1, Text, Text);
//with calLatest do if Length(Text) > 0 then Responses.Update('LATEST', 1, Text, Text);
if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text) if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text)
else Responses.Update('MISC', 1, '', ''); else Responses.Update('MISC', 1, '', '');
if Length(ProvDx.Code) > 0 then Responses.Update('CODE', 1, ProvDx.Code, ProvDx.Code) if Length(ProvDx.Code) > 0 then Responses.Update('CODE', 1, ProvDx.Code, ProvDx.Code)
@ -414,6 +466,8 @@ begin
SetControl(cboUrgency, 'URGENCY', 1); SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1); SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1); SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
SetTemplateDialogCanceled(FALSE); SetTemplateDialogCanceled(FALSE);
SetControl(memReason, 'COMMENT', 1); SetControl(memReason, 'COMMENT', 1);
if WasTemplateDialogCanceled and OrderContainsObjects then if WasTemplateDialogCanceled and OrderContainsObjects then
@ -587,6 +641,17 @@ begin
end; end;
end; end;
procedure TfrmODProc.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
begin
if ScreenReaderSystemActive and not ctrl.Enabled then begin
lbl.Enabled := True;
lbl.Visible := True;
lbl.Caption := lblService.Caption + ', ' + Text;
lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left;
end else
lbl.Visible := false;
end;
procedure TfrmODProc.cboServiceChange(Sender: TObject); procedure TfrmODProc.cboServiceChange(Sender: TObject);
begin begin
inherited; inherited;
@ -812,6 +877,20 @@ begin
DoSetFontSize(FontSize); DoSetFontSize(FontSize);
end; end;
procedure TfrmODProc.updateService;
begin
with cboService do
if ItemIEN > 0 then
begin
setup508Label(Text, servicelbl508, cboService);
Responses.Update('SERVICE', 1, ItemID, Text);
end
else begin
Responses.Update('SERVICE', 1, '', '');
setup508Label('No service selected.', servicelbl508, cboService);
end;
end;
procedure TfrmODProc.DoSetFontSize(FontSize: integer); procedure TfrmODProc.DoSetFontSize(FontSize: integer);
begin begin
memReason.Width := pnlReason.ClientWidth; memReason.Width := pnlReason.ClientWidth;
@ -839,16 +918,40 @@ end;
procedure TfrmODProc.FormResize(Sender: TObject); procedure TfrmODProc.FormResize(Sender: TObject);
begin begin
inherited; inherited;
memOrder.Top := PnlReason.Top + PnlReason.Height + 5; if Patient.CombatVet.IsEligible then
begin
memOrder.Top := pnlCombatVet.Height + PnlReason.Top + PnlReason.Height + 7;
end
else
begin
memOrder.Top := PnlReason.Top + PnlReason.Height + 7;
end;
end; end;
procedure TfrmODProc.FormShow(Sender: TObject);
begin
inherited;
setup508Label('No service selected.', servicelbl508, cboService);
end;
procedure TfrmODProc.FormClose(Sender: TObject; var Action: TCloseAction); procedure TfrmODProc.FormClose(Sender: TObject; var Action: TCloseAction);
begin begin
inherited; inherited;
frmFrame.pnlVisit.Enabled := true; frmFrame.pnlVisit.Enabled := true;
end; end;
procedure TfrmODProc.SetUpCombatVet;
begin
pnlCombatVet.BringToFront;
txtCombatVet.Enabled := True;
txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
pnlMain.Anchors := [akLeft,akTop,akRight];
self.Height := self.Height + pnlCombatVet.Height;
pnlMain.Anchors := [akLeft,akTop,akRight,akBottom];
end;
end. end.

6
CPRS-Chart/Consults/fPreReq.pas
View File

@ -136,7 +136,6 @@ begin
repeat repeat
with Lines do with Lines do
begin begin
AddStrings(AHeader);
for i := 0 to MaxLines do for i := 0 to MaxLines do
if i < memReport.Lines.Count then if i < memReport.Lines.Count then
Add(memReport.Lines[LastLine + i]) Add(memReport.Lines[LastLine + i])
@ -156,7 +155,7 @@ begin
end; end;
end; end;
until LastLine >= memReport.Lines.Count - 1; until LastLine >= memReport.Lines.Count - 1;
PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg); PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg, True);
end; end;
finally finally
memPrintReport.Free; memPrintReport.Free;
@ -184,8 +183,9 @@ end;
procedure TfrmPrerequisites.FormCreate(Sender: TObject); procedure TfrmPrerequisites.FormCreate(Sender: TObject);
begin begin
inherited; inherited;
ResizeAnchoredFormToFont(Self);
SetFormPosition(Self); //Get Saved Position & Size of Form SetFormPosition(Self); //Get Saved Position & Size of Form
ResizeAnchoredFormToFont(Self);
//SetFormPosition(Self); //Get Saved Position & Size of Form
end; end;
procedure TfrmPrerequisites.OnActivate(Sender: TObject); procedure TfrmPrerequisites.OnActivate(Sender: TObject);

14
CPRS-Chart/Consults/rConsults.pas
View File

@ -95,6 +95,7 @@ function GetProcedureIEN(ORIEN: string): string;
function GetConsultOrderIEN(ConsultIEN: integer): string; function GetConsultOrderIEN(ConsultIEN: integer): string;
function GetServicePrerequisites(Service: string): TStrings; function GetServicePrerequisites(Service: string): TStrings;
procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string); procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
function IsProstheticsService(SvcIen: int64) : string;
{ Clinical Procedures Specific} { Clinical Procedures Specific}
function GetSavedCPFields(NoteIEN: integer): TEditNoteRec; function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
@ -353,6 +354,8 @@ begin
InOut := Piece(x, U, 18) ; InOut := Piece(x, U, 18) ;
Findings := Piece(x, U, 19) ; Findings := Piece(x, U, 19) ;
TIUResultNarrative := StrToIntDef(Piece(x, U, 20),0); TIUResultNarrative := StrToIntDef(Piece(x, U, 20),0);
EarliestDate := StrToFloatDef(Piece(x, U, 98), 0);
//LatestDate := StrToFloatDef(Piece(x, U, 99), 0); //dropped requirement WAT
//ProvDiagnosis := Piece(x, U, 23); NO!!!!! Up to 180 Characters!!!! //ProvDiagnosis := Piece(x, U, 23); NO!!!!! Up to 180 Characters!!!!
alist.delete(0) ; alist.delete(0) ;
TIUDocuments := TStringList.Create ; TIUDocuments := TStringList.Create ;
@ -667,6 +670,8 @@ begin
ConsultProcName := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 2); ConsultProcName := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 2);
Urgency := StrToIntDef(Piece(ExtractDefault(Dest, 'URGENCY'), U, 3), 0); Urgency := StrToIntDef(Piece(ExtractDefault(Dest, 'URGENCY'), U, 3), 0);
UrgencyName := Piece(ExtractDefault(Dest, 'URGENCY'), U, 2); UrgencyName := Piece(ExtractDefault(Dest, 'URGENCY'), U, 2);
EarliestDate := StrToFloatDef(Piece(ExtractDefault(Dest, 'EARLIEST'), U, 2), 0);
//LatestDate := StrToFloatDef(Piece(ExtractDefault(Dest, 'LATEST'), U, 2), 0); //dropped requirement WAT
Place := Piece(ExtractDefault(Dest, 'PLACE'), U, 1); Place := Piece(ExtractDefault(Dest, 'PLACE'), U, 1);
PlaceName := Piece(ExtractDefault(Dest, 'PLACE'), U, 2); PlaceName := Piece(ExtractDefault(Dest, 'PLACE'), U, 2);
Attention := StrToInt64Def(Piece(ExtractDefault(Dest, 'ATTENTION'), U, 1), 0); Attention := StrToInt64Def(Piece(ExtractDefault(Dest, 'ATTENTION'), U, 1), 0);
@ -733,6 +738,10 @@ begin
for i := 0 to NewComments.Count - 1 do for i := 0 to NewComments.Count - 1 do
Mult['10,' + IntToStr(i+1)] := NewComments.Strings[i]; Mult['10,' + IntToStr(i+1)] := NewComments.Strings[i];
end; end;
if EarliestDate > 0 then
Mult['11'] := 'GMRCERDT^' + FloatToStr(EarliestDate); //wat renamed v28
{if LatestDate > 0 then
Mult['12'] := 'GMRCLATE^' + FloatToStr(LatestDate);} //dropped requirement WAT
end; end;
CallBroker; CallBroker;
Result := '0'; Result := '0';
@ -835,6 +844,11 @@ begin
Result := AnEditRec; Result := AnEditRec;
end; end;
function IsProstheticsService(SvcIen : int64) : string; //wat v28
begin
Result := sCallV('ORQQCN ISPROSVC', [SvcIen]);
end;
initialization initialization
uLastOrderedIEN := 0; uLastOrderedIEN := 0;
uLastOrderMsg := ''; uLastOrderMsg := '';

134
CPRS-Chart/Consults/uConsults.pas
View File

@ -3,7 +3,8 @@ unit uConsults;
interface interface
uses uses
SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls; SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls,
Contnrs, DateUtils;
type type
@ -37,8 +38,8 @@ type
ProvDiagnosis: string ; { 30} { * } ProvDiagnosis: string ; { 30} { * }
ProvDxCode: string; { 30.1} ProvDxCode: string; { 30.1}
RequestProcessingActivity: TStringList; { 40} RequestProcessingActivity: TStringList; { 40}
//EarliestDate: TFMDateTime; EarliestDate: TFMDateTime;
//LatestDate: TFMDateTime; //LatestDate: TFMDateTime; //dropped requirement WAT
end ; end ;
TEditResubmitRec = record TEditResubmitRec = record
@ -52,8 +53,8 @@ type
ConsultProcName: string; ConsultProcName: string;
Urgency: integer; Urgency: integer;
UrgencyName: string; UrgencyName: string;
//EarliestDate: TFMDateTime; EarliestDate: TFMDateTime;
//LatestDate: TFMDateTime; //LatestDate: TFMDateTime; //dropped requirement WAT
Place: string; Place: string;
PlaceName: string; PlaceName: string;
Attention: int64; Attention: int64;
@ -258,36 +259,109 @@ end;
procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode); procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode);
var var
MyID, MyParent, Name, temp: string; MyID, MyParent, Name, item: string;
i: Integer; i, Idx: Integer;
ChildNode, tmpNode: TORTreeNode; ParentNode, ChildNode: TORTreeNode;
// tmpNode: TORTreeNode;
HasChildren: Boolean; HasChildren: Boolean;
// AllNodes: TStringList;
ParentNodes: TStringList;
// List: TList;
// Lists: TObjectList;
// bad: boolean;
// Former code was only filtering out half the duplicates, depending on
// how they appeared in the tree. Commented out code filters out all the duplicates,
// and still keeps the fast tree build. However, CPRS Clinical Workgroup determined
// that no duplicates should be filtered out. Code kept here in order to keep fast filter
// logic, in case duplicates are ever filtered out in the future.
{
procedure FilterOutDuplicates;
var
j: integer;
begin
bad := false;
if AllNodes.Find(MyID, Idx) then
begin
if AllNodes.Objects[Idx] is TORTreeNode then
begin
tmpNode := TORTreeNode(AllNodes.Objects[Idx]);
bad := tmpNode.HasAsParent(ParentNode);
if (not bad) and assigned(tmpNode.Parent) then
bad := ParentNode.HasAsParent(tmpNode.Parent);
end
else
begin
bad := False;
List := TList(AllNodes.Objects[Idx]);
for j := 0 to List.Count - 1 do
begin
tmpNode := TORTreeNode(List[j]);
bad := TORTreeNode(List[j]).HasAsParent(ParentNode);
if (not bad) and assigned(tmpNode.Parent) then
bad := ParentNode.HasAsParent(tmpNode.Parent);
if bad then break;
end;
end;
end;
end;
procedure AddNode;
begin
if AllNodes.Find(MyID, Idx) then
begin
if AllNodes.Objects[Idx] is TORTreeNode then
begin
List := TList.Create;
Lists.Add(List);
List.Add(AllNodes.Objects[Idx]);
AllNodes.Objects[Idx] := List;
end
else
List := TList(AllNodes.Objects[Idx]);
List.Add(ChildNode);
end
else
AllNodes.AddObject(MyId, ChildNode);
end;
}
begin begin
Tree.Items.BeginUpdate; Tree.Items.BeginUpdate;
with SvcList do for i := 0 to Count - 1 do ParentNodes := TStringList.Create;
// AllNodes := TStringList.Create;
// Lists := TObjectList.Create;
try
ParentNodes.Sorted := True;
// AllNodes.Sorted := True;
for i := 0 to SvcList.Count - 1 do
begin begin
if Piece(Strings[i], U, 5) = 'S' then Continue; // V19.4 {rv} item := SvcList[i];
//if Piece(Strings[i], U, 6) = 'S' then Continue; if Piece(item, U, 5) = 'S' then Continue;
MyParent := Piece(Strings[i], U, 3); MyParent := Piece(item, U, 3);
if (MyParent = Parent) then MyID := Piece(item, U, 1);
begin if not ParentNodes.Find(MyParent, Idx) then
MyID := Piece(Strings[i], U, 1); ParentNode := nil
Name := Piece(Strings[i], U, 2); else
temp := Strings[i]; begin
tmpNode := nil; ParentNode := TORTreeNode(ParentNodes.Objects[Idx]);
HasChildren := Piece(Strings[i], U, 4) = '+'; // FilterOutDuplicates;
if Node <> nil then if Node.HasChildren then // if bad then Continue;
tmpNode := Tree.FindPieceNode(MyID, 1, U, Node); end;
if (tmpNode <> nil) and tmpNode.HasAsParent(Node) then Name := Piece(item, U, 2);
Continue HasChildren := Piece(item, U, 4) = '+';
else ChildNode := TORTreeNode(Tree.Items.AddChild(ParentNode, Name));
begin ChildNode.StringData := item;
ChildNode := TORTreeNode(Tree.Items.AddChild(Node, Name)); // AddNode;
ChildNode.StringData := temp; if HasChildren then
if HasChildren then BuildServiceTree(Tree, SvcList, MyID, ChildNode); ParentNodes.AddObject(MyID, ChildNode);
end;
end;
end; end;
finally
ParentNodes.Free;
// AllNodes.Free;
// Lists.Free;
end;
Tree.Items.EndUpdate; Tree.Items.EndUpdate;
end; end;

123
CPRS-Chart/Encounter/fDiagnoses.pas
View File

@ -24,7 +24,8 @@ type
Rect: TRect; State: TOwnerDrawState); Rect: TRect; State: TOwnerDrawState);
private private
procedure EnsurePrimaryDiag; procedure EnsurePrimaryDiag;
function isProblem(diagnosis: TPCEDiag): Boolean;
function isEncounterDx(problem: string): Boolean;
protected protected
procedure UpdateNewItemStr(var x: string); override; procedure UpdateNewItemStr(var x: string); override;
procedure UpdateControls; override; procedure UpdateControls; override;
@ -37,6 +38,9 @@ const
'Before you can select this problem, you must update the ICD code it contains' + #13#10 + 'Before you can select this problem, you must update the ICD code it contains' + #13#10 +
'via the Problems tab.'; 'via the Problems tab.';
TC_INACTIVE_CODE = 'Problem Contains Inactive Code'; TC_INACTIVE_CODE = 'Problem Contains Inactive Code';
TX_REDUNDANT_DX = 'The problem that you''ve selected is already included in the list of diagnoses' + #13#10 +
'for this encounter. No need to select it again...';
TC_REDUNDANT_DX = 'Redundant Diagnosis: ';
var var
frmDiagnoses: TfrmDiagnoses; frmDiagnoses: TfrmDiagnoses;
@ -64,8 +68,8 @@ begin
if not Primary and (Items.Count > 0) then if not Primary and (Items.Count > 0) then
begin begin
GridIndex := 0; GridIndex := Items.Count - 1;//0; vhaispbellc CQ 15836
TPCEDiag(Items.Objects[0]).Primary := True; TPCEDiag(Items.Objects[Items.Count - 1]).Primary := True;
GridChanged; GridChanged;
end; end;
end; end;
@ -100,6 +104,7 @@ begin
for i := 0 to lbGrid.Items.Count-1 do for i := 0 to lbGrid.Items.Count-1 do
if(lbGrid.Selected[i]) then if(lbGrid.Selected[i]) then
TPCEDiag(lbGrid.Items.Objects[i]).AddProb := (ckbDiagProb.Checked) and TPCEDiag(lbGrid.Items.Objects[i]).AddProb := (ckbDiagProb.Checked) and
(not isProblem(TPCEDiag(lbGrid.Items.Objects[i]))) and
(TPCEDiag(lbGrid.Items.Objects[i]).Category <> PL_ITEMS); (TPCEDiag(lbGrid.Items.Objects[i]).Category <> PL_ITEMS);
GridChanged; GridChanged;
end; end;
@ -131,6 +136,81 @@ begin
x := x + U + '0'; x := x + U + '0';
end; end;
function TfrmDiagnoses.isProblem(diagnosis: TPCEDiag): Boolean;
var
i: integer;
p, code, narr, sct: String;
begin
result := false;
for i := 0 to FProblems.Count - 1 do
begin
p := FProblems[i];
code := piece(p, '^', 1);
narr := piece(p, '^', 2);
if (pos('SCT', narr) > 0) or (pos('SNOMED', narr) > 0) then
sct := piece(piece(piece(narr, ')', 1), '(', 2), ' ', 2)
else
sct := '';
narr := TrimRight(piece(narr, '(',1));
if pos(diagnosis.Code, code) > 0 then
begin
result := true;
break;
end
else if (sct <> '') and (pos(sct, diagnosis.Narrative) > 0) then
begin
result := true;
break;
end
else if pos(narr, diagnosis.Narrative) > 0 then
begin
result := true;
break;
end;
end;
end;
function TfrmDiagnoses.isEncounterDx(problem: string): Boolean;
var
i: integer;
dx, code, narr, pCode, pNarrative, sct: String;
function getSCT(narr: string): string;
begin
if (pos('SNOMED CT ', narr) > 0) then
result := copy(narr, pos('SNOMED CT ', narr) + 10, length(narr))
else
result := '';
end;
begin
result := false;
pCode := piece(problem, U, 1);
pNarrative := piece(problem, U, 2);
for i := 0 to lbGrid.Items.Count - 1 do
begin
dx := lbGrid.Items[i];
narr := piece(dx, U, 3);
code := piece(piece(copy(narr, pos('ICD-9-CM', narr), length(narr)), ' ', 2), ')', 1);
sct := getSCT(piece(narr, ':', 1));
if pos(pCode, narr) > 0 then
begin
result := true;
break;
end
else if (sct <> '') and (pos(sct, pNarrative) > 0) then
begin
result := true;
break;
end
else if pos(narr, pNarrative) > 0 then
begin
result := true;
break;
end;
end;
end;
procedure TfrmDiagnoses.UpdateControls; procedure TfrmDiagnoses.UpdateControls;
var var
i, j, k, PLItemCount: integer; i, j, k, PLItemCount: integer;
@ -148,8 +228,13 @@ begin
PLItemCount := 0; PLItemCount := 0;
if OK then if OK then
for k := 0 to lbGrid.Items.Count - 1 do for k := 0 to lbGrid.Items.Count - 1 do
if (lbGrid.Selected[k]) and (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) then begin
PLItemCount := PLItemCount + 1; if (lbGrid.Selected[k]) then
begin
if (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) or isProblem(TPCEDiag(lbGrid.Items.Objects[k])) then
PLItemCount := PLItemCount + 1;
end;
end;
OK := OK and (PLItemCount < lbGrid.SelCount); OK := OK and (PLItemCount < lbGrid.SelCount);
ckbDiagProb.Enabled := OK; ckbDiagProb.Enabled := OK;
if(OK) then if(OK) then
@ -179,8 +264,7 @@ end;
procedure TfrmDiagnoses.FormResize(Sender: TObject); procedure TfrmDiagnoses.FormResize(Sender: TObject);
begin begin
inherited; inherited;
if lbxSection.width = 0 then Exit; FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (10 * MainFontWidth) - ScrollBarWidth);
FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth);
FSectionTabs[1] := -FSectionTabs[0]+2; FSectionTabs[1] := -FSectionTabs[0]+2;
FSectionTabs[2] := -FSectionTabs[0]+4; FSectionTabs[2] := -FSectionTabs[0]+4;
UpdateTabPos; UpdateTabPos;
@ -189,13 +273,22 @@ end;
procedure TfrmDiagnoses.lbxSectionClickCheck(Sender: TObject; procedure TfrmDiagnoses.lbxSectionClickCheck(Sender: TObject;
Index: Integer); Index: Integer);
begin begin
if not FUpdatingGrid then if (not FUpdatingGrid) and (lbxSection.Checked[Index]) then
if (lbxSection.Checked[Index]) and (Piece(lbxSection.Items[Index], U, 5) = '#') then begin
begin if (Piece(lbxSection.Items[Index], U, 5) = '#') then
InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK); begin
lbxSection.Checked[Index] := False; InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
exit; lbxSection.Checked[Index] := False;
end; exit;
end
else if isEncounterDx(lbxSection.Items[Index]) then
begin
InfoBox(TX_REDUNDANT_DX, TC_REDUNDANT_DX + piece(lbxSection.Items[Index], '^',2),
MB_ICONWARNING or MB_OK);
lbxSection.Checked[Index] := False;
exit;
end;
end;
inherited; inherited;
EnsurePrimaryDiag; EnsurePrimaryDiag;
end; end;
@ -219,7 +312,7 @@ var
dxCode, dxName: string; dxCode, dxName: string;
ADiagnosis: TPCEItem; ADiagnosis: TPCEItem;
begin begin
inherited; inherited;
UBAGlobals.BAPCEDiagList.Clear; UBAGlobals.BAPCEDiagList.Clear;
with lbGrid do for i := 0 to Items.Count - 1 do with lbGrid do for i := 0 to Items.Count - 1 do
begin begin

17
CPRS-Chart/Encounter/fEncVitals.pas
View File

@ -402,11 +402,7 @@ begin
uVitalNew.free; uVitalNew.free;
{== Vitals Lite 2004-05-21 ===================================================} {== Vitals Lite 2004-05-21 ===================================================}
if VitalsDLLHandle <> 0 then UnloadVitalsDLL;
begin
FreeLibrary(VitalsDLLHandle);
VitalsDLLHandle := 0;
end;
{== Vitals Lite 2004-05-21 ===================================================} {== Vitals Lite 2004-05-21 ===================================================}
inherited; inherited;
end; end;
@ -428,18 +424,13 @@ end;
procedure TfrmEncVitals.FormShow(Sender: TObject); procedure TfrmEncVitals.FormShow(Sender: TObject);
var
GMV_LibName: String;
begin begin
inherited; inherited;
//Begin Vitals Lite //Begin Vitals Lite
{Visit is Assumed to Be selected when Opening Encounter Dialog} {Visit is Assumed to Be selected when Opening Encounter Dialog}
GMV_LibName :='GMV_VitalsViewEnter.dll'; LoadVitalsDLL;
GMV_LibName := GetProgramFilesPath + SHARE_DIR + GMV_LibName;
if VitalsDLLHandle = 0 then
VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
if VitalsDLLHandle = 0 then // No Handle found if VitalsDLLHandle = 0 then // No Handle found
MessageDLG('Can''t find library "'+GMV_LibName+'".',mtError,[mbok],0) MessageDLG('Can''t find library '+VitalsDLLName+'.',mtError,[mbok],0)
else else
LoadVitalsList; LoadVitalsList;
//End Vitals Lite //End Vitals Lite
@ -618,7 +609,6 @@ begin
@VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName)); @VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName));
if assigned(VLPtVitals) then if assigned(VLPtVitals) then
begin begin
// frmFrame.DLLActive := True; // need this flag for CCOW (RV)
VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false); VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false);
if assigned(VitalsList) then if assigned(VitalsList) then
LoadVitalView(VitalsList); LoadVitalView(VitalsList);
@ -626,7 +616,6 @@ begin
else else
MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0); MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0);
@VLPtVitals := nil; @VLPtVitals := nil;
// frmFrame.DLLActive := False; // need this flag for CCOW (RV)
end; end;
//End Vitals Lite //End Vitals Lite

2
CPRS-Chart/Encounter/fEncounterFrame.dfm
View File

@ -6,7 +6,7 @@ inherited frmEncounterFrame: TfrmEncounterFrame
ClientWidth = 632 ClientWidth = 632
FormStyle = fsMDIForm FormStyle = fsMDIForm
OldCreateOrder = True OldCreateOrder = True
Position = poScreenCenter Position = poMainFormCenter
OnCanResize = FormCanResize OnCanResize = FormCanResize
OnClose = FormClose OnClose = FormClose
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery

3
CPRS-Chart/Encounter/fEncounterFrame.pas
View File

@ -399,8 +399,9 @@ begin
uProviders.AddProvider(AUser, uProviders.PendingName(FALSE), FALSE); uProviders.AddProvider(AUser, uProviders.PendingName(FALSE), FALSE);
frmEncounterFrame.CreateChildForms(frmEncounterFrame, PCEData.Location); frmEncounterFrame.CreateChildForms(frmEncounterFrame, PCEData.Location);
ResizeAnchoredFormToFont(frmEncounterFrame);
SetFormPosition(frmEncounterFrame); SetFormPosition(frmEncounterFrame);
ResizeAnchoredFormToFont(frmEncounterFrame);
//SetFormPosition(frmEncounterFrame);
with frmEncounterFrame do with frmEncounterFrame do
begin begin

1
CPRS-Chart/Encounter/fPCEBase.dfm
View File

@ -4,6 +4,7 @@ inherited frmPCEBase: TfrmPCEBase
Caption = 'Basic Page' Caption = 'Basic Page'
ClientHeight = 400 ClientHeight = 400
ClientWidth = 624 ClientWidth = 624
Position = poMainFormCenter
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
ExplicitWidth = 320 ExplicitWidth = 320

2
CPRS-Chart/Encounter/fPCEBaseGrid.dfm
View File

@ -2,8 +2,6 @@ inherited frmPCEBaseGrid: TfrmPCEBaseGrid
Left = 128 Left = 128
Top = 192 Top = 192
Caption = 'frmPCEBaseGrid' Caption = 'frmPCEBaseGrid'
ExplicitLeft = 128
ExplicitTop = 192
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pnlGrid: TPanel [2] object pnlGrid: TPanel [2]

2
CPRS-Chart/Encounter/fPCEBaseGrid.pas
View File

@ -4,7 +4,7 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn, fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn, uPCE,
VA508AccessibilityManager; VA508AccessibilityManager;
type type

4
CPRS-Chart/Encounter/fPCEBaseMain.dfm
View File

@ -2,8 +2,6 @@ inherited frmPCEBaseMain: TfrmPCEBaseMain
Left = 302 Left = 302
Top = 166 Top = 166
Caption = 'frmPCEBaseMain' Caption = 'frmPCEBaseMain'
ExplicitWidth = 320
ExplicitHeight = 240
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblSection: TLabel [0] object lblSection: TLabel [0]
@ -157,8 +155,6 @@ inherited frmPCEBaseMain: TfrmPCEBaseMain
LongList = False LongList = False
Pieces = '3' Pieces = '3'
CheckEntireLine = True CheckEntireLine = True
ExplicitLeft = -3
ExplicitTop = -2
end end
object btnOther: TButton object btnOther: TButton
Left = 65 Left = 65

14
CPRS-Chart/Encounter/fPCEBaseMain.pas
View File

@ -59,6 +59,7 @@ type
FPCEItemClass: TPCEItemClass; FPCEItemClass: TPCEItemClass;
FPCECode: string; FPCECode: string;
FSplitterMove: boolean; FSplitterMove: boolean;
FProblems: TStringList;
function GetCat: string; function GetCat: string;
procedure UpdateNewItemStr(var x: string); virtual; procedure UpdateNewItemStr(var x: string); virtual;
// procedure UpdateNewItem(APCEItem: TPCEItem); virtual; // procedure UpdateNewItem(APCEItem: TPCEItem); virtual;
@ -85,7 +86,7 @@ const
implementation implementation
uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch, VA508AccessibilityRouter, uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch, VA508AccessibilityRouter,
ORCtrlsVA508Compatibility, fBase508Form; ORCtrlsVA508Compatibility, fBase508Form, UBAConst;
{$R *.DFM} {$R *.DFM}
@ -103,6 +104,11 @@ begin
FPCEListCodesProc(lbxSection.Items, lbSection.ItemIEN); FPCEListCodesProc(lbxSection.Items, lbSection.ItemIEN);
CheckOffEntries; CheckOffEntries;
FSectionPopulated := TRUE; FSectionPopulated := TRUE;
if (lbSection.Items.Count > 0) then
lblList.Caption := StringReplace(lbSection.DisplayText[lbSection.ItemIndex],
'&', '&&', [rfReplaceAll] );
if (lbSection.DisplayText[lbSection.ItemIndex] = DX_PROBLEM_LIST_TXT) then
FastAssign(lbxSection.Items, FProblems);
end; end;
procedure TfrmPCEBaseMain.lbSectionExit(Sender: TObject); procedure TfrmPCEBaseMain.lbSectionExit(Sender: TObject);
@ -295,17 +301,15 @@ end;
procedure TfrmPCEBaseMain.FormCreate(Sender: TObject); procedure TfrmPCEBaseMain.FormCreate(Sender: TObject);
begin begin
inherited FormCreate(Sender); inherited FormCreate(Sender);
FProblems := TStringList.Create;
lbxSection.HideSelection := TRUE; lbxSection.HideSelection := TRUE;
amgrMain.ComponentManager[lbSection] := TLBSectionManager.Create; amgrMain.ComponentManager[lbSection] := TLBSectionManager.Create;
end; end;
procedure TfrmPCEBaseMain.FormDestroy(Sender: TObject); procedure TfrmPCEBaseMain.FormDestroy(Sender: TObject);
var
i:integer;
begin begin
inherited; inherited;
with lbGrid.Items do for i := 0 to Count - 1 do TPCEItem(Objects[i]).Free; FProblems.Free;
end; end;
procedure TfrmPCEBaseMain.InitTab(ACopyProc: TCopyItemsMethod; AListProc: TListSectionsProc); procedure TfrmPCEBaseMain.InitTab(ACopyProc: TCopyItemsMethod; AListProc: TListSectionsProc);

11
CPRS-Chart/Encounter/fPCEEdit.pas
View File

@ -49,6 +49,13 @@ var
begin begin
Result := FALSE; Result := FALSE;
(* agp moved from FormCreate to addrss a problem with editing an encounter without a note displaying in CPRS*)
if uPatient <> Patient.DFN then
begin
KillObj(@uPCETemp);
KillObj(@uPCETempOld);
end;
uPatient := Patient.DFN;
if (Encounter.VisitCategory = 'H') then if (Encounter.VisitCategory = 'H') then
begin begin
if Assigned(NoteData) then if Assigned(NoteData) then
@ -129,12 +136,14 @@ end;
procedure TfrmPCEEdit.FormCreate(Sender: TObject); procedure TfrmPCEEdit.FormCreate(Sender: TObject);
begin begin
(* agp moved to EditPCEData procedure to addrss a problem
with editing an encounter without a note displaying in CPRS
if uPatient <> Patient.DFN then if uPatient <> Patient.DFN then
begin begin
KillObj(@uPCETemp); KillObj(@uPCETemp);
KillObj(@uPCETempOld); KillObj(@uPCETempOld);
end; end;
uPatient := Patient.DFN; uPatient := Patient.DFN; *)
end; end;
initialization initialization

5
CPRS-Chart/Encounter/fPCELex.dfm
View File

@ -6,10 +6,9 @@ inherited frmPCELex: TfrmPCELex
Caption = 'Lookup Other Diagnosis' Caption = 'Lookup Other Diagnosis'
ClientHeight = 275 ClientHeight = 275
ClientWidth = 429 ClientWidth = 429
Position = poScreenCenter Position = poOwnerFormCenter
OnCreate = FormCreate OnCreate = FormCreate
ExplicitWidth = 320 ExplicitHeight = 307
ExplicitHeight = 240
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblSearch: TLabel [0] object lblSearch: TLabel [0]

5
CPRS-Chart/Encounter/fProcedure.dfm
View File

@ -3,7 +3,7 @@ inherited frmProcedures: TfrmProcedures
Top = 172 Top = 172
Caption = 'Encounter Procedure' Caption = 'Encounter Procedure'
ExplicitWidth = 632 ExplicitWidth = 632
ExplicitHeight = 427 ExplicitHeight = 434
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblProcQty: TLabel [0] object lblProcQty: TLabel [0]
@ -92,12 +92,13 @@ inherited frmProcedures: TfrmProcedures
TabOrder = 2 TabOrder = 2
end end
object spnProcQty: TUpDown [11] object spnProcQty: TUpDown [11]
Left = 348 Left = 353
Top = 371 Top = 371
Width = 15 Width = 15
Height = 21 Height = 21
Associate = txtProcQty Associate = txtProcQty
Min = 1 Min = 1
Max = 999
Position = 1 Position = 1
TabOrder = 5 TabOrder = 5
end end

6
CPRS-Chart/Encounter/fVisitType.dfm
View File

@ -6,9 +6,8 @@ inherited frmVisitType: TfrmVisitType
Constraints.MinHeight = 465 Constraints.MinHeight = 465
Constraints.MinWidth = 600 Constraints.MinWidth = 600
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
ExplicitLeft = 260
ExplicitWidth = 600 ExplicitWidth = 600
ExplicitHeight = 472 ExplicitHeight = 465
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
inherited btnOK: TBitBtn inherited btnOK: TBitBtn
@ -192,7 +191,7 @@ inherited frmVisitType: TfrmVisitType
Height = 164 Height = 164
Align = alRight Align = alRight
TabOrder = 1 TabOrder = 1
ExplicitLeft = 384 ExplicitLeft = 422
ExplicitWidth = 208 ExplicitWidth = 208
ExplicitHeight = 164 ExplicitHeight = 164
inherited gbVisitRelatedTo: TGroupBox inherited gbVisitRelatedTo: TGroupBox
@ -255,6 +254,7 @@ inherited frmVisitType: TfrmVisitType
TabOrder = 0 TabOrder = 0
OnEnter = memSCDisplayEnter OnEnter = memSCDisplayEnter
Caption = 'Service Connection && Rated Disabilities' Caption = 'Service Connection && Rated Disabilities'
ExplicitWidth = 422
end end
end end
end end

BIN
CPRS-Chart/JAWS Support Files/jaws.SR
View File

Binary file not shown.

10
CPRS-Chart/Options/fOptions.dfm
View File

@ -1,7 +1,6 @@
inherited frmOptions: TfrmOptions inherited frmOptions: TfrmOptions
Left = 315 Left = 315
Top = 110 Top = 110
Width = 435
Height = 397 Height = 397
HelpContext = 9999 HelpContext = 9999
VertScrollBar.Range = 360 VertScrollBar.Range = 360
@ -10,11 +9,8 @@ inherited frmOptions: TfrmOptions
Caption = 'Options' Caption = 'Options'
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
HelpFile = 'CPRSWT.HLP' HelpFile = 'CPRSWT.HLP'
OldCreateOrder = True
Position = poScreenCenter Position = poScreenCenter
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy
ExplicitWidth = 435
ExplicitHeight = 397 ExplicitHeight = 397
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
@ -1358,10 +1354,10 @@ inherited frmOptions: TfrmOptions
TabOrder = 6 TabOrder = 6
end end
object memReport2: TMemo object memReport2: TMemo
Left = 128 Left = 135
Top = 213 Top = 212
Width = 273 Width = 273
Height = 47 Height = 48
TabStop = False TabStop = False
BorderStyle = bsNone BorderStyle = bsNone
Color = clBtnFace Color = clBtnFace

4
CPRS-Chart/Options/fOptions.pas
View File

@ -4,10 +4,10 @@ interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ComCtrls, ExtCtrls, ORCtrls, OrFn, Dialogs, ORDtTmRng, fBAOptionsDiagnoses, Buttons, ComCtrls, ExtCtrls, ORCtrls, OrFn, Dialogs, ORDtTmRng, fBAOptionsDiagnoses,
uBAGlobals, fBase508Form, VA508AccessibilityManager; uBAGlobals, fBase508Form, VA508AccessibilityManager, fAutoSz;
type type
TfrmOptions = class(TfrmBase508Form) TfrmOptions = class(TfrmAutoSz)
pnlMain: TPanel; pnlMain: TPanel;
pnlBottom: TPanel; pnlBottom: TPanel;
pagOptions: TPageControl; pagOptions: TPageControl;

5
CPRS-Chart/Options/fOptionsCombinations.pas
View File

@ -184,7 +184,10 @@ begin
valuesource := radAddByType.Items[radAddByType.ItemIndex]; valuesource := radAddByType.Items[radAddByType.ItemIndex];
if copy(valuesource, 1, 1) = '&' then if copy(valuesource, 1, 1) = '&' then
valuesource := copy(valuesource, 2, length(valuesource) - 1); valuesource := copy(valuesource, 2, length(valuesource) - 1);
valuename := Piece(lstAddBy.DisplayText[lstAddBy.ItemIndex], '-', 1); { if radAddByType.ItemIndex = 2 then
valuename := Piece(lstAddBy.DisplayText[lstAddBy.ItemIndex], '-', 1)
else } //Removed per PTM 274 - should not peice by the "-" at all
valuename := lstAddBy.DisplayText[lstAddBy.ItemIndex];
valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1); valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
if Duplicate(valueien, valuesource) then exit; // check for duplicates if Duplicate(valueien, valuesource) then exit; // check for duplicates
aListItem := lvwCombinations.Items.Add; aListItem := lvwCombinations.Items.Add;

8
CPRS-Chart/Options/fOptionsLists.dfm
View File

@ -11,10 +11,8 @@ inherited frmOptionsLists: TfrmOptionsLists
Position = poScreenCenter Position = poScreenCenter
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
ExplicitLeft = 354 ExplicitWidth = 413
ExplicitTop = 178 ExplicitHeight = 474
ExplicitWidth = 415
ExplicitHeight = 469
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblAddby: TLabel [0] object lblAddby: TLabel [0]
@ -122,8 +120,8 @@ inherited frmOptionsLists: TfrmOptionsLists
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 1 TabOrder = 1
OnChange = lstAddByChange
OnClick = lstAddByClick OnClick = lstAddByClick
OnKeyPress = lstAddByKeyPress
OnNeedData = lstAddByNeedData OnNeedData = lstAddByNeedData
CharsNeedMatch = 1 CharsNeedMatch = 1
end end

35
CPRS-Chart/Options/fOptionsLists.pas
View File

@ -57,6 +57,7 @@ type
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure lstAddByKeyPress(Sender: TObject; var Key: Char); procedure lstAddByKeyPress(Sender: TObject; var Key: Char);
procedure grpVisibilityClick(Sender: TObject); procedure grpVisibilityClick(Sender: TObject);
procedure lstAddByChange(Sender: TObject);
private private
{ Private declarations } { Private declarations }
FLastList: integer; FLastList: integer;
@ -145,7 +146,7 @@ begin
begin begin
case radAddByType.ItemIndex of case radAddByType.ItemIndex of
0: begin 0: begin
ListItemsOnly := true; ListItemsOnly := false;
LongList := true; LongList := true;
InitLongList(''); InitLongList('');
lblAddby.Caption := 'Patient:'; lblAddby.Caption := 'Patient:';
@ -255,6 +256,37 @@ begin
btnListSaveChanges.Enabled := false; btnListSaveChanges.Enabled := false;
end; end;
procedure TfrmOptionsLists.lstAddByChange(Sender: TObject);
procedure ShowMatchingPatients;
begin
with lstAddBy do begin
if ShortCount > 0 then begin
if ShortCount = 1 then begin
ItemIndex := 0;
end;
Items.Add(LLS_LINE);
Items.Add(LLS_SPACE);
end;
InitLongList('');
end;
end;
begin
inherited;
if radAddByType.ItemIndex = 0 {patient} then begin
with lstAddBy do
if frmPtSelOptns.IsLast5(Text) then begin
ListPtByLast5(Items, Text);
ShowMatchingPatients;
end
else if frmPtSelOptns.IsFullSSN(Text) then begin
ListPtByFullSSN(Items, Text);
ShowMatchingPatients;
end;
end;
end;
procedure TfrmOptionsLists.lstAddByClick(Sender: TObject); procedure TfrmOptionsLists.lstAddByClick(Sender: TObject);
var var
ien: string; ien: string;
@ -265,6 +297,7 @@ var
begin begin
if lstAddBy.ItemIndex < 0 then exit; if lstAddBy.ItemIndex < 0 then exit;
ien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1); ien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
If ien = '' then exit;
case radAddByType.ItemIndex of case radAddByType.ItemIndex of
0: 0:
begin begin

5
CPRS-Chart/Options/fOptionsNotes.pas
View File

@ -31,6 +31,7 @@ type
Direction, InsertAt: Integer); Direction, InsertAt: Integer);
procedure cboCosignerExit(Sender: TObject); procedure cboCosignerExit(Sender: TObject);
private private
FStartingCosigner: Int64;
{ Private declarations } { Private declarations }
public public
{ Public declarations } { Public declarations }
@ -97,7 +98,7 @@ begin
cboCosigner.Items.Add('0^<none>'); cboCosigner.Items.Add('0^<none>');
cboCosigner.InitLongList(cosignername); cboCosigner.InitLongList(cosignername);
cboCosigner.SelectByIEN(cosigner); cboCosigner.SelectByIEN(cosigner);
cboCosigner.Tag := cosigner; FStartingCosigner := cosigner;
chkAskSubject.Checked := rpcGetSubject; chkAskSubject.Checked := rpcGetSubject;
if chkAskSubject.Checked then chkAskSubject.Tag := 1; if chkAskSubject.Checked then chkAskSubject.Tag := 1;
end; end;
@ -125,7 +126,7 @@ begin
if (Checked and (Tag = 0)) or (not Checked and (Tag = 1)) then if (Checked and (Tag = 0)) or (not Checked and (Tag = 1)) then
rpcSetSubject(Checked); rpcSetSubject(Checked);
with cboCosigner do with cboCosigner do
if Tag <> ItemIEN then if FStartingCosigner <> ItemIEN then
rpcSetDefaultCosigner(ItemIEN); rpcSetDefaultCosigner(ItemIEN);
ResetTIUPreferences; ResetTIUPreferences;
ResetDCSummPreferences; ResetDCSummPreferences;

2
CPRS-Chart/Options/fOptionsOther.dfm
View File

@ -12,6 +12,7 @@ inherited frmOptionsOther: TfrmOptionsOther
HelpFile = 'CPRSWT.HLP' HelpFile = 'CPRSWT.HLP'
Position = poScreenCenter Position = poScreenCenter
ShowHint = True ShowHint = True
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
PixelsPerInch = 96 PixelsPerInch = 96
@ -96,6 +97,7 @@ inherited frmOptionsOther: TfrmOptionsOther
Caption = 'Cancel' Caption = 'Cancel'
ModalResult = 2 ModalResult = 2
TabOrder = 1 TabOrder = 1
OnClick = btnCancelClick
end end
end end
object stStart: TStaticText [6] object stStart: TStaticText [6]

58
CPRS-Chart/Options/fOptionsOther.pas
View File

@ -47,11 +47,14 @@ type
procedure txtEncStartExit(Sender: TObject); procedure txtEncStartExit(Sender: TObject);
procedure txtEncStopExit(Sender: TObject); procedure txtEncStopExit(Sender: TObject);
procedure btnEncDefaultsClick(Sender: TObject); procedure btnEncDefaultsClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure btnCancelClick(Sender: TObject);
private private
{ Private declarations } { Private declarations }
FstartDt: TFMDateTime; FstartDt: TFMDateTime;
FstopDt: TFMDateTime; FstopDt: TFMDateTime;
FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer; FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer;
OK2Closed: boolean;
//FDefaultEvent: string; //FDefaultEvent: string;
public public
{ Public declarations } { Public declarations }
@ -106,6 +109,7 @@ var
last: integer; last: integer;
values, tab: string; values, tab: string;
begin begin
OK2Closed := True;
FastAssign(rpcGetOtherTabs, cboTab.Items); FastAssign(rpcGetOtherTabs, cboTab.Items);
if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then
cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery')); cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery'));
@ -141,6 +145,7 @@ procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
var var
values, theVal: string; values, theVal: string;
begin begin
OK2Closed := True;
values := ''; values := '';
if cboTab.ItemIEN <> cboTab.Tag then if cboTab.ItemIEN <> cboTab.Tag then
values := values + cboTab.ItemID; values := values + cboTab.ItemID;
@ -153,6 +158,40 @@ begin
values := values + '0'; values := values + '0';
values := values + '^^'; values := values + '^^';
rpcSetOther(values); rpcSetOther(values);
if (dtStart.Text = '') and (dtStop.Text = '') then
begin
if InfoBox('A date range is not set for the meds tab. Continue?', 'No Date Range Defined', MB_YESNO) = ID_NO then
begin
dtStart.SetFocus;
OK2Closed := false;
Exit;
end;
end
else if (dtStart.Text = '') or (dtStop.Text = '') then
begin
ShowMsg('A complete date range needs to be set. ');
if dtStart.Text = '' then dtStart.SetFocus
else dtStop.SetFocus;
OK2Closed := false;
Exit;
end;
//if Pos('Y', Uppercase(dtStart.Text))>0 then
if Uppercase(Copy(dtStart.Text, Length(dtStart.Text), Length(dtStart.Text))) = 'Y' then
begin
ShowMsg('Start Date relative date cannot have a Y');
OK2Closed := false;
dtStart.SetFocus;
Exit;
end;
//if Pos('Y', Uppercase(dtStop.Text))>0 then
if Uppercase(Copy(dtStop.Text, Length(dtStop.Text), Length(dtStop.Text))) = 'Y' then
begin
ShowMsg('Stop Date relative date cannot have a Y');
OK2Closed := false;
dtStart.SetFocus;
Exit;
end;
if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
begin begin
if dtStop.FMDateTime < dtStart.FMDateTime then if dtStop.FMDateTime < dtStart.FMDateTime then
@ -160,6 +199,7 @@ begin
ShowMsg('The stop time can not prior to the start time.'); ShowMsg('The stop time can not prior to the start time.');
dtStop.FMDateTime := FMToday; dtStop.FMDateTime := FMToday;
dtStop.SetFocus; dtStop.SetFocus;
OK2Closed := false;
Exit; Exit;
end; end;
theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime; theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime;
@ -172,6 +212,14 @@ begin
frmMeds.RefreshMedLists; frmMeds.RefreshMedLists;
end; end;
procedure TfrmOptionsOther.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
inherited;
CanClose := OK2Closed;
end;
procedure TfrmOptionsOther.FormCreate(Sender: TObject); procedure TfrmOptionsOther.FormCreate(Sender: TObject);
begin begin
FStartDT := 0; FStartDT := 0;
@ -203,13 +251,13 @@ end;
procedure TfrmOptionsOther.dtStartChange(Sender: TObject); procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
begin begin
if (dtStart.FMDateTime > FMToday) then (* if (dtStart.FMDateTime > FMToday) then
begin begin
ShowMsg('Start time can not greater than today.'); ShowMsg('Start time can not greater than today.');
dtStart.FMDateTime := FMToday; dtStart.FMDateTime := FMToday;
dtStart.SetFocus; dtStart.SetFocus;
Exit; Exit;
end; end; *)
end; end;
procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject); procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
@ -264,6 +312,12 @@ with txtEncStart do
Text := '0'; Text := '0';
end; end;
procedure TfrmOptionsOther.btnCancelClick(Sender: TObject);
begin
inherited;
OK2Closed := True;
end;
procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject); procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
begin begin
txtEncStart.Text := IntToStr(FEncDefStartDays); txtEncStart.Text := IntToStr(FEncDefStartDays);

42
CPRS-Chart/Orders/fOCAccept.dfm
View File

@ -3,21 +3,27 @@ inherited frmOCAccept: TfrmOCAccept
Top = 257 Top = 257
BorderIcons = [] BorderIcons = []
Caption = 'Order Checking' Caption = 'Order Checking'
ClientHeight = 169 ClientHeight = 186
ClientWidth = 472 ClientWidth = 622
Constraints.MinHeight = 200
Constraints.MinWidth = 600
Position = poScreenCenter Position = poScreenCenter
ExplicitLeft = 305 ExplicitWidth = 630
ExplicitTop = 257 ExplicitHeight = 220
ExplicitWidth = 480
ExplicitHeight = 203
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object memChecks: TRichEdit [0] object memChecks: TRichEdit [0]
Left = 0 Left = 0
Top = 0 Top = 0
Width = 472 Width = 622
Height = 136 Height = 153
Align = alClient Align = alClient
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True ReadOnly = True
ScrollBars = ssVertical ScrollBars = ssVertical
TabOrder = 0 TabOrder = 0
@ -25,15 +31,15 @@ inherited frmOCAccept: TfrmOCAccept
end end
object pnlBottom: TPanel [1] object pnlBottom: TPanel [1]
Left = 0 Left = 0
Top = 136 Top = 153
Width = 472 Width = 622
Height = 33 Height = 33
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
object cmdAccept: TButton object cmdAccept: TButton
Left = 148 Left = 148
Top = 7 Top = 6
Width = 80 Width = 80
Height = 21 Height = 21
Caption = 'Accept Order' Caption = 'Accept Order'
@ -50,6 +56,17 @@ inherited frmOCAccept: TfrmOCAccept
Caption = 'Cancel Order' Caption = 'Cancel Order'
ModalResult = 7 ModalResult = 7
TabOrder = 1 TabOrder = 1
OnClick = cmdCancelClick
end
object Button1: TButton
Left = 384
Top = 6
Width = 145
Height = 21
Caption = 'Drug Interaction Monograph'
Enabled = False
TabOrder = 2
OnClick = Button1Click
end end
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
@ -68,6 +85,9 @@ inherited frmOCAccept: TfrmOCAccept
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = frmOCAccept' 'Component = frmOCAccept'
'Status = stsDefault')
(
'Component = Button1'
'Status = stsDefault')) 'Status = stsDefault'))
end end
end end

55
CPRS-Chart/Orders/fOCAccept.pas
View File

@ -4,7 +4,7 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager; fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager, rOrders, fOCMonograph;
type type
TfrmOCAccept = class(TfrmAutoSz) TfrmOCAccept = class(TfrmAutoSz)
@ -12,6 +12,10 @@ type
pnlBottom: TPanel; pnlBottom: TPanel;
cmdAccept: TButton; cmdAccept: TButton;
cmdCancel: TButton; cmdCancel: TButton;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure cmdCancelClick(Sender: TObject);
procedure FormResize(Sender: TObject);
private private
{ Private declarations } { Private declarations }
public public
@ -26,18 +30,37 @@ implementation
function AcceptOrderWithChecks(OCList: TStringList): Boolean; function AcceptOrderWithChecks(OCList: TStringList): Boolean;
var var
i: Integer; i,j: Integer;
frmOCAccept: TfrmOCAccept; frmOCAccept: TfrmOCAccept;
begin substring: String;
remOC: TStringList;
begin
remOC := TStringList.Create;
Result := True; Result := True;
if OCList.Count > 0 then if OCList.Count > 0 then
begin begin
frmOCAccept := TfrmOCAccept.Create(Application); frmOCAccept := TfrmOCAccept.Create(Application);
try try
ResizeFormToFont(TForm(frmOCAccept)); ResizeFormToFont(TForm(frmOCAccept));
frmOCAccept.Button1.Enabled := false;
if IsMonograph then frmOCAccept.Button1.Enabled := true;
for i := 0 to OCList.Count - 1 do for i := 0 to OCList.Count - 1 do
begin begin
frmOCAccept.memChecks.Lines.Add(Piece(OCList[i], U, 4)); substring := Copy(Piece(OCList[i], U, 4),0,2);
if substring='||' then
begin
substring := Copy(Piece(OCList[i], U, 4),3,Length(Piece(OCList[i], U, 4)));
GetXtraTxt(remOC,Piece(substring,'&',1),Piece(substring,'&',2));
frmOCAccept.memChecks.Lines.Add('('+inttostr(i+1)+' of '+inttostr(OCList.Count)+') ' + Piece(substring,'&',2));
for j:= 0 to remOC.Count - 1 do frmOCAccept.memChecks.Lines.Add(' '+remOC[j]);
frmOCAccept.memChecks.Lines.Add(' ');
end
else
begin
frmOCAccept.memChecks.Lines.Add('('+inttostr(i+1)+' of '+inttostr(OCList.Count)+') ' + Piece(OCList[i], U, 4));
end;
frmOCAccept.memChecks.Lines.Add(''); frmOCAccept.memChecks.Lines.Add('');
end; end;
frmOCAccept.memChecks.SelStart := 0; frmOCAccept.memChecks.SelStart := 0;
@ -45,8 +68,32 @@ begin
Result := frmOCAccept.ShowModal = mrYes; Result := frmOCAccept.ShowModal = mrYes;
finally finally
frmOCAccept.Release; frmOCAccept.Release;
remOC.Destroy;
end; end;
end; end;
end; end;
procedure TfrmOCAccept.Button1Click(Sender: TObject);
var
monoList: TStringList;
begin
inherited;
monoList := TStringList.Create;
GetMonographList(monoList);
ShowMonographs(monoList);
monoList.Free;
end;
procedure TfrmOCAccept.cmdCancelClick(Sender: TObject);
begin
inherited;
DeleteMonograph;
end;
procedure TfrmOCAccept.FormResize(Sender: TObject);
begin
inherited;
memChecks.Refresh;
end;
end. end.

231
CPRS-Chart/Orders/fOCSession.dfm
View File

@ -1,112 +1,206 @@
inherited frmOCSession: TfrmOCSession inherited frmOCSession: TfrmOCSession
Left = 366 Left = 366
Top = 222 Top = 222
Width = 714
Height = 530
HorzScrollBar.Visible = True
VertScrollBar.Visible = True
AutoScroll = True
BorderIcons = [] BorderIcons = []
Caption = 'Order Checks' Caption = 'Order Checks'
ClientWidth = 494 Constraints.MinHeight = 500
Constraints.MinWidth = 500
Position = poScreenCenter Position = poScreenCenter
ShowHint = True ShowHint = True
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate
OnMouseWheelDown = FormMouseWheelDown
OnShow = FormShow OnShow = FormShow
ExplicitWidth = 502 ExplicitWidth = 714
ExplicitHeight = 240 ExplicitHeight = 530
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lstChecks: TCaptionListBox [0] object pnlBottom: TPanel [0]
Left = 0 Left = 0
Top = 0 Top = 352
Width = 494 Width = 706
Height = 162 Height = 146
Style = lbOwnerDrawVariable Anchors = [akLeft, akTop, akBottom]
Align = alClient
ItemHeight = 13
MultiSelect = True
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnDrawItem = lstChecksDrawItem
OnMeasureItem = lstChecksMeasureItem
HintOnItem = True
end
object pnlBottom: TPanel [1]
Left = 0
Top = 162
Width = 494
Height = 111
Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 0 TabOrder = 0
DesignSize = ( DesignSize = (
494 706
111) 146)
object lblJustify: TLabel object lblJustify: TLabel
Left = 9 Left = 9
Top = 34 Top = 58
Width = 248 Width = 234
Height = 13 Height = 13
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft]
Caption = 'Enter justification for overriding critical order checks -' Caption = 'Enter reason for overriding order checks:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object memNote: TMemo
Left = 392
Top = 12
Width = 306
Height = 40
BorderStyle = bsNone
Color = clBtnFace
Lines.Strings = (
'NOTE: The override reason is for tracking purposes and '
'does not change or place new order(s).')
ReadOnly = True
TabOrder = 0
OnEnter = memNoteEnter
end end
object txtJustify: TCaptionEdit object txtJustify: TCaptionEdit
Left = 8 Left = 8
Top = 50 Top = 80
Width = 478 Width = 682
Height = 21 Height = 21
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft]
AutoSize = False
MaxLength = 80 MaxLength = 80
TabOrder = 0 TabOrder = 3
OnKeyDown = txtJustifyKeyDown OnKeyDown = txtJustifyKeyDown
Caption = 'Enter justification for overriding critical order checks -' Caption = 'Enter justification for overriding critical order checks -'
end end
object cmdCancelOrder: TButton object cmdCancelOrder: TButton
Left = 356 Left = 9
Top = 5 Top = 17
Width = 131 Width = 168
Height = 21 Height = 21
Anchors = [akLeft, akTop, akRight] Caption = 'Cancel Checked Order(s)'
Caption = 'Cancel Selected Order(s)' Font.Charset = DEFAULT_CHARSET
TabOrder = 3 Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = cmdCancelOrderClick OnClick = cmdCancelOrderClick
end end
object cmdContinue: TButton object cmdContinue: TButton
Left = 157 Left = 219
Top = 82 Top = 112
Width = 70 Width = 127
Height = 21 Height = 23
Caption = 'Continue' Anchors = [akLeft, akTop, akRight, akBottom]
Caption = 'Accept Order(s)'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 4 TabOrder = 4
OnClick = cmdContinueClick OnClick = cmdContinueClick
end end
object btnReturn: TButton object btnReturn: TButton
Left = 241 Left = 352
Top = 82 Top = 112
Width = 97 Width = 122
Height = 21 Height = 23
Anchors = [akLeft, akTop, akRight, akBottom]
Cancel = True Cancel = True
Caption = 'Return to Orders' Caption = 'Return to Orders'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5 TabOrder = 5
OnClick = btnReturnClick OnClick = btnReturnClick
end end
object memNote: TMemo object cmdMonograph: TButton
Left = 8 Left = 536
Top = 4 Top = 107
Width = 329 Width = 162
Height = 29 Height = 21
BorderStyle = bsNone Anchors = [akRight, akBottom]
Color = clBtnFace Caption = 'Drug Interaction Monograph'
Lines.Strings = ( TabOrder = 6
'NOTE: The override justification is for tracking purposes and ' OnClick = cmdMonographClick
'does not change or place new order(s).') end
ReadOnly = True end
object pnlTop: TORAutoPanel [1]
Left = 0
Top = 0
Width = 706
Height = 346
Align = alTop
BevelEdges = []
BevelOuter = bvNone
TabOrder = 1
DesignSize = (
706
346)
object lblHover: TLabel
Left = 16
Top = 32
Width = 445
Height = 13
Caption =
'If the order check description is cut short, hover over the text' +
' to view the complete description.'
end
object grdchecks: TCaptionStringGrid
Left = 16
Top = 64
Width = 682
Height = 279
Margins.Top = 0
Anchors = [akLeft, akBottom]
ColCount = 3
DefaultDrawing = False
FixedColor = clBtnShadow
FixedCols = 0
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goRowMoving, goTabs]
ScrollBars = ssVertical
TabOrder = 1 TabOrder = 1
OnEnter = memNoteEnter OnDrawCell = grdchecksDrawCell
OnEnter = grdchecksEnter
OnKeyDown = grdchecksKeyDown
OnMouseDown = grdchecksMouseDown
OnMouseMove = grdchecksMouseMove
OnMouseWheelDown = grdchecksMouseWheelDown
OnMouseWheelUp = grdchecksMouseWheelUp
OnSelectCell = grdchecksSelectCell
JustToTab = True
end
object lblInstr: TVA508StaticText
Name = 'lblInstr'
Left = 0
Top = 12
Width = 641
Height = 15
Margins.Bottom = 0
Alignment = taLeftJustify
AutoSize = True
Caption =
'To cancel an order select the order by checking the checkbox and' +
' press the "Cancel Checked Order(s)" button.'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
TabStop = True
ShowAccelChar = True
end end
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
(
'Component = lstChecks'
'Status = stsDefault')
( (
'Component = pnlBottom' 'Component = pnlBottom'
'Status = stsDefault') 'Status = stsDefault')
@ -127,6 +221,15 @@ inherited frmOCSession: TfrmOCSession
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = frmOCSession' 'Component = frmOCSession'
'Status = stsDefault')
(
'Component = cmdMonograph'
'Status = stsDefault')
(
'Component = grdchecks'
'Status = stsDefault')
(
'Component = pnlTop'
'Status = stsDefault')) 'Status = stsDefault'))
end end
end end

793
CPRS-Chart/Orders/fOCSession.pas
View File

@ -3,12 +3,12 @@ unit fOCSession;
interface interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fOCMonograph,
fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager; fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager,
Grids, strUtils, uDlgComponents, VAUtils, VA508AccessibilityRouter;
type type
TfrmOCSession = class(TfrmAutoSz) TfrmOCSession = class(TfrmAutoSz)
lstChecks: TCaptionListBox;
pnlBottom: TPanel; pnlBottom: TPanel;
lblJustify: TLabel; lblJustify: TLabel;
txtJustify: TCaptionEdit; txtJustify: TCaptionEdit;
@ -16,12 +16,13 @@ type
cmdContinue: TButton; cmdContinue: TButton;
btnReturn: TButton; btnReturn: TButton;
memNote: TMemo; memNote: TMemo;
cmdMonograph: TButton;
grdchecks: TCaptionStringGrid;
lblInstr: TVA508StaticText;
pnlTop: TORAutoPanel;
lblHover: TLabel;
procedure cmdCancelOrderClick(Sender: TObject); procedure cmdCancelOrderClick(Sender: TObject);
procedure cmdContinueClick(Sender: TObject); procedure cmdContinueClick(Sender: TObject);
procedure lstChecksMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure lstChecksDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure FormResize(Sender: TObject); procedure FormResize(Sender: TObject);
@ -29,6 +30,32 @@ type
Shift: TShiftState); Shift: TShiftState);
procedure btnReturnClick(Sender: TObject); procedure btnReturnClick(Sender: TObject);
procedure memNoteEnter(Sender: TObject); procedure memNoteEnter(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure cmdMonographClick(Sender: TObject);
procedure grdchecksDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
function CheckBoxRect(poRect: TRect): TRect;
function GetCheckState(grid: TStringGrid; ACol, ARow: integer): boolean;
function InCheckBox(Grid: TStringGrid; X, Y, ACol, ARow: integer): boolean;
procedure SetCheckState(grid: TStringGrid; ACol, ARow: integer; State: boolean);
procedure grdchecksMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure grdchecksSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure GridDeleteRow(RowNumber: Integer; Grid: TstringGrid);
procedure grdchecksEnter(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure grdchecksKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure grdchecksMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure grdchecksMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure grdchecksMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
// procedure memNoteSetText(str: string);
private private
FCritical: Boolean; FCritical: Boolean;
FCancelSignProcess : Boolean; FCancelSignProcess : Boolean;
@ -111,13 +138,12 @@ end;
Clears OrderList If False. } Clears OrderList If False. }
function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean; function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean;
var var
i, j: Integer; i, j, k, l, m, rowcnt: Integer;
LastID, NewID: string; LastID, NewID, gridtext: string;
CheckList: TStringList; CheckList,remOC: TStringList;
OCRec: TOCRec; OCRec: TOCRec;
//AChangeItem: TChangeItem;
frmOCSession: TfrmOCSession; frmOCSession: TfrmOCSession;
x: string; x,substring: string;
begin begin
Result := True; Result := True;
CheckList := TStringList.Create; CheckList := TStringList.Create;
@ -128,6 +154,14 @@ begin
if CheckList.Count > 0 then if CheckList.Count > 0 then
begin begin
frmOCSession := TfrmOCSession.Create(Application); frmOCSession := TfrmOCSession.Create(Application);
//frmOCSession.grdchecks.RowCount := frmOCSession.grdchecks.RowCount + 1; *)
//rowcnt := frmOCSession.grdchecks.RowCount;
//if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
rowcnt := 1;
frmOCSession.grdchecks.canvas.Font.Name := 'Courier New';
frmOCSession.grdchecks.Canvas.Font.Size := MainFontSize;
frmOCSession.cmdMonograph.Enabled := false;
if IsMonograph then frmOCSession.cmdMonograph.Enabled := true;
try try
ResizeFormToFont(TForm(frmOCSession)); ResizeFormToFont(TForm(frmOCSession));
uCheckedOrders := TList.Create; uCheckedOrders := TList.Create;
@ -147,15 +181,69 @@ begin
OCRec := TOCRec(Items[i]); OCRec := TOCRec(Items[i]);
x := TextForOrder(OCRec.OrderID); x := TextForOrder(OCRec.OrderID);
OCRec.OrderText := x; OCRec.OrderText := x;
frmOCSession.grdchecks.Cells[2,rowcnt] := OCRec.OrderID + '^O^0^';
frmOCSession.grdchecks.Cells[1,rowcnt] := OCRec.OrderText;
RowCnt := RowCnt + 1;
if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
l := 0;
m := 0;
for j := 0 to CheckList.Count - 1 do
if Piece(CheckList[j], U, 1) = OCRec.OrderID then m := m+1;
for j := 0 to CheckList.Count - 1 do for j := 0 to CheckList.Count - 1 do
if Piece(CheckList[j], U, 1) = OCRec.OrderID then if Piece(CheckList[j], U, 1) = OCRec.OrderID then
begin begin
OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4)); l := l+1;
x := x + CRLF + Piece(CheckList[j], U, 4); gridText := '';
substring := Copy(Piece(CheckList[j], U, 4),0,2);
if substring='||' then
begin
remOC := TStringList.Create;
substring := Copy(Piece(CheckList[j], U, 4),3,Length(Piece(CheckList[j], U, 4)));
GetXtraTxt(remOC,Piece(substring,'&',1),Piece(substring,'&',2));
for k := 0 to remOC.Count - 1 do
begin
//add each line to x and OCRec.Checks
if k=remOC.Count-1 then
begin
OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+' '+RemOC[k]);
x := x + CRLF + RemOC[k];
if gridText = '' then gridText := RemOC[k]
else gridText := gridText + CRLF + ' ' +RemOC[k];
end
else if k=0 then
begin
OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+RemOC[k]);
x := x + CRLF + '('+inttostr(l)+' of '+inttostr(m)+') ' + RemOC[k];
if gridText = '' then gridText := '('+inttostr(l)+' of '+inttostr(m)+') ' + RemOC[k]
else gridText := gridText + CRLF + RemOC[k];
end
else
begin
OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+' '+RemOC[k]);
x := x + CRLF + RemOC[k];
if gridText = '' then gridText := RemOC[k]
else gridText := gridText + CRLF + ' ' + RemOC[k];
end;
end;
x := x + CRLF + ' ';
if gridText = '' then gridText := ' '
else gridText := gridText + CRLF + ' ';
remOC.free;
end
else
begin
OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4));
x := x + CRLF + '('+inttostr(l)+' of '+inttostr(m)+') ' + Piece(CheckList[j], U, 4);
gridText := '('+inttostr(l)+' of '+inttostr(m)+') ' + Piece(CheckList[j], U, 4);
end;
if (Piece(CheckList[j], U, 3) = '1') then frmOCSession.grdchecks.Cells[1,rowcnt] := '*Order Check requires Reason for Override' + CRLF + gridText
else frmOCSession.grdchecks.Cells[1,rowcnt] := gridText;
frmOCSession.grdchecks.Cells[2,rowcnt] := OCRec.OrderID + '^I^'+Piece(CheckList[j], U, 3);
//frmOCSession.grdchecks.Objects[2, rowcnt] := OCRec;
rowcnt := rowcnt +1;
if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
end; end;
//AChangeItem := Changes.Locate(CH_ORD, OCRec.OrderID);
//if AChangeItem <> nil then OCRec.OrderText := AChangeItem.Text;
frmOCSession.lstChecks.Items.Add(x);
end; {with...for i} end; {with...for i}
frmOCSession.FOrderList := OrderList; frmOCSession.FOrderList := OrderList;
frmOCSession.FCheckList := CheckList; frmOCSession.FCheckList := CheckList;
@ -169,6 +257,17 @@ begin
if Assigned(frmFrame) then if Assigned(frmFrame) then
frmFrame.SetActiveTab(CT_ORDERS); frmFrame.SetActiveTab(CT_ORDERS);
end; end;
if ScreenReaderActive = True then
begin
frmOCSession.lblInstr.TabStop := true;
frmOCSession.memNote.TabStop := true;
frmOCSession.memNote.TabOrder := 2;
end
else
begin
frmOCSession.lblInstr.TabStop := false;
frmOCSession.memNote.TabStop := false;
end;
finally finally
with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free; with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free;
frmOCSession.Free; frmOCSession.Free;
@ -179,6 +278,19 @@ begin
end; end;
end; end;
procedure TfrmOCSession.SetCheckState(grid: TStringGrid; ACol, ARow: integer;
State: boolean);
var
temp: string;
begin
temp := grid.Cells[2, ARow];
if State = True then SetPiece(temp, U, 3, '1')
else SetPiece(temp, U, 3, '0');
grid.Cells[2, ARow] := temp;
grid.Repaint;
end;
procedure TfrmOCSession.SetReqJustify; procedure TfrmOCSession.SetReqJustify;
var var
i, j: Integer; i, j: Integer;
@ -194,135 +306,604 @@ begin
lblJustify.Visible := FCritical; lblJustify.Visible := FCritical;
txtJustify.Visible := FCritical; txtJustify.Visible := FCritical;
memNote.Visible := FCritical; memNote.Visible := FCritical;
end; end;
procedure TfrmOCSession.lstChecksMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); function TfrmOCSession.CheckBoxRect(poRect: TRect): TRect;
var const ciCheckBoxDim = 20;
i, AHt, TotalHt: Integer;
x: string;
ARect: TRect;
OCRec: TOCRec;
begin begin
inherited; with poRect do begin
Result.Top := Top + FontHeightPixel(Font.Handle);
with lstChecks do Result.Left := Left - (ciCheckBoxDim div 2) + (Right - Left) div 2;
begin Result.Right := Result.Left + ciCheckBoxDim;
if Index >= uCheckedOrders.Count then Exit; Result.Bottom := Result.Top + ciCheckBoxDim;
OCRec := TOCRec(uCheckedOrders.Items[Index]); end
ARect := ItemRect(Index);
ARect.Left := ARect.Left + 2;
AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
TotalHt := AHt;
for i := 0 to OCRec.Checks.Count - 1 do
begin
ARect := ItemRect(Index);
ARect.Left := ARect.Left + 10;
x := Piece(OCRec.Checks[i], U, 3);
AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
TotalHt := TotalHt + AHt;
end;
end;
Height := TotalHt + 2; // add 2 for focus rectangle
if Height > 255 then Height := 255; //CQ7178
end;
procedure TfrmOCSession.lstChecksDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
i, AHt: Integer;
x: string;
ARect: TRect;
OCRec: TOCRec;
begin
inherited;
with lstChecks do
begin
if Index >= uCheckedOrders.Count then Exit;
OCRec := TOCRec(uCheckedOrders.Items[Index]);
ARect := ItemRect(Index);
AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
ARect.Left := ARect.Left + 10;
ARect.Top := ARect.Top + AHt;
for i := 0 to OCRec.Checks.Count - 1 do
begin
x := Piece(OCRec.Checks[i], U, 3);
if not (odSelected in State) then
begin
if (Piece(OCRec.Checks[i], U, 2) = '1') then
begin
Canvas.Font.Color := Get508CompliantColor(clBlue);
Canvas.Font.Style := [fsUnderline];
end
else Canvas.Font.Color := clWindowText;
end;
AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
ARect.Top := ARect.Top + AHt;
end;
end;
end; end;
procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject); procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject);
var var
i, j: Integer; cnt, i, j, already: Integer;
AnOrderID: string; AnOrderID: string;
OCRec: TOCRec; DeleteOrderList, DeleteRowList: TstringList;
StillCritical: boolean;
begin begin
inherited; inherited;
for i := lstChecks.Items.Count - 1 downto 0 do if lstChecks.Selected[i] then DeleteOrderList := TStringList.Create;
begin DeleteRowList := TStringList.Create;
OCRec := TOCRec(uCheckedOrders.Items[i]); for I := 0 to grdChecks.RowCount do
AnOrderID := OCRec.OrderID; if (Piece(grdChecks.Cells[2, i], U, 3) = '1') and (Piece(grdChecks.Cells[2, i], U, 2) = 'O') then
if DeleteCheckedOrder(AnOrderID) then begin
AnOrderID := Piece(grdChecks.Cells[2, i], U, 1);
already := DeleteOrderList.IndexOf(AnOrderID);
if (already>=0) or (DeleteCheckedOrder(AnOrderID)) then
begin
for j := FCheckList.Count - 1 downto 0 do
if Piece(FCheckList[j], U, 1) = AnOrderID then FCheckList.Delete(j);
DeleteOrderList.Add(AnOrderId);
for j := FOrderList.Count - 1 downto 0 do
if Piece(FOrderList[j], U, 1) = AnOrderID then FOrderList.Delete(j);
for j := uCheckedOrders.Count - 1 downto 0 do
if TOCRec(uCheckedOrders.Items[j]).OrderID = AnOrderId then
end;
end;
if DeleteOrderList.Count = 0 then
begin
infoBox('No orders are marked to cancel. Check the Cancel box by the orders to cancel. ', 'Error', MB_OK);
end;
for i := 0 to DeleteOrderList.Count - 1 do
begin
AnOrderId := DeleteORderList.Strings[i];
for j := 0 to grdChecks.RowCount do
if Piece(grdChecks.Cells[2, j], u, 1) = AnOrderId then
begin
//grdChecks.Rows[j].Clear;
DeleteRowList.Add(InttoStr(j));
end;
end;
if (grdChecks.RowCount - 1) = DeleteRowList.Count then Close;
cnt := 0;
for i := 0 to DeleteRowList.Count - 1 do
begin
GridDeleteRow(((StrtoInt(DeleteRowList.Strings[i])) - cnt), grdChecks);
cnt := cnt +1;
end;
//check if the remaining order checks are not high level and thus don't require justification
if FCritical then
begin begin
for j := FCheckList.Count - 1 downto 0 do StillCritical := false;
if Piece(FCheckList[j], U, 1) = AnOrderID then FCheckList.Delete(j); for I := 0 to grdChecks.RowCount do
for j := FOrderList.Count - 1 downto 0 do begin
if Piece(FOrderList[j], U, 1) = AnOrderID then FOrderList.Delete(j); if ((Piece(grdChecks.cells[2,I],U,3) = '1') and not(Piece(grdChecks.Cells[2, i], U, 2) = 'O')) then
OCRec.Free; begin
uCheckedOrders.Delete(i); StillCritical := true;
lstChecks.Items.Delete(i); break;
end;
end;
if StillCritical = false then
begin
FCritical := false;
lblJustify.Visible := FCritical;
txtJustify.Visible := FCritical;
memNote.Visible := FCritical;
end;
end; end;
end; grdChecks.Repaint;
if uCheckedOrders.Count = 0 then Close;
end; end;
procedure TfrmOCSession.cmdContinueClick(Sender: TObject); procedure TfrmOCSession.cmdContinueClick(Sender: TObject);
var
i: integer;
Cancel: boolean;
begin begin
inherited; inherited;
Cancel := False;
if FCritical and ((Length(txtJustify.Text) < 2) or not ContainsVisibleChar(txtJustify.Text)) then if FCritical and ((Length(txtJustify.Text) < 2) or not ContainsVisibleChar(txtJustify.Text)) then
begin begin
InfoBox('A justification for overriding critical order checks is required.', InfoBox('A justification for overriding critical order checks is required.',
'Justification Required', MB_OK); 'Justification Required', MB_OK);
Exit; Exit;
end; end;
if FCritical and (ContainsUpCarretChar(txtJustify.Text)) then
begin
InfoBox('The justification may not contain the ^ character.',
'Justification Required', MB_OK);
Exit;
end;
for i := 0 to grdChecks.RowCount do
if (Piece(grdChecks.Cells[2, i], U, 3) = '1') and (Piece(grdChecks.Cells[2, i], U, 2) = 'O') then
begin
Cancel := True;
Break;
end;
if Cancel = True then
begin
InfoBox('One or more orders have been marked to cancel!' + CRLF + CRLF +
'To cancel these orders, click the "Cancel Checked Order(s)" button.' + CRLF + CRLF +
'To place these orders, uncheck the Cancel box beside the order you wish to keep and then click the "Accept Order(s)" button again.',
'Error', MB_OK);
Exit;
end;
StatusText('Saving Order Checks...'); StatusText('Saving Order Checks...');
SaveOrderChecksForSession(txtJustify.Text, FCheckList); SaveOrderChecksForSession(txtJustify.Text, FCheckList);
StatusText(''); StatusText('');
Close; Close;
end; end;
procedure TfrmOCSession.cmdMonographClick(Sender: TObject);
var
monoList: TStringList;
begin
inherited;
monoList := TStringList.Create;
GetMonographList(monoList);
ShowMonographs(monoList);
monoList.Free;
end;
procedure TfrmOCSession.FormClose(Sender: TObject; procedure TfrmOCSession.FormClose(Sender: TObject;
var Action: TCloseAction); var Action: TCloseAction);
begin begin
inherited; inherited;
SaveUserBounds(Self); //Save Position & Size of Form SaveUserBounds(Self); //Save Position & Size of Form
DeleteMonograph;
end;
procedure TfrmOCSession.FormCreate(Sender: TObject);
begin
inherited;
grdChecks.Cells[0, 0] := 'Cancel';
grdChecks.Cells[1, 0] := 'Order/Order Check Text';
//cmdMonograph.Font.Size := MainFontSize;
//cmdMonograph.Width := TextWidthByFont(cmdMonograph.Font.Handle, cmdMonograph.Caption);
end; end;
procedure TfrmOCSession.FormShow(Sender: TObject); procedure TfrmOCSession.FormShow(Sender: TObject);
begin begin
inherited; inherited;
SetFormPosition(Self); //Get Saved Position & Size of Form SetFormPosition(Self); //Get Saved Position & Size of Form
FCancelSignProcess := False; FCancelSignProcess := False;
if ScreenReaderActive = True then lblInstr.SetFocus
else
begin
lblInstr.TabStop := false;
grdChecks.SetFocus;
end;
self.lblInstr.Font.Size := mainFontSize + 1;
//self.lblJustify.Height := self.lblJustify.Height + 20;
(*if self.lblJustify.Visible = true then
begin
self.lblJustify.top := self.txtJustify.Top + self.lblJustify.Height + 50;
end; *)
//if mainFontSize < 12 then inc := 90
//else if mainFontSize < 18 then inc := 130
//else inc := 155;
//self.constraints.MinWidth := self.lblInstr.Left + TextWidthByFont(self.lblInstr.Font.Handle, self.lblInstr.Caption) + inc;
end; end;
procedure TfrmOCSession.grdchecksDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
Wrap: boolean;
format, str, cdl, temp, colorText: string;
IsBelowOrder, isSelected: boolean;
chkRect, DrawRect, colorRect: TRect;
ChkState: Cardinal;
begin
inherited;
temp := grdChecks.Cells[2, ARow];
format := Piece(grdChecks.Cells[2, ARow], U, 2);
cdl := Piece(grdChecks.Cells[2, ARow], U, 3);
colorText := '*Order Check requires Reason for Override';
grdChecks.Canvas.Brush.Color := Get508CompliantColor(clWhite);
grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlack);
grdChecks.Canvas.Font.Style := [];
isSelected := false;
if ARow = 0 then
begin
grdChecks.Canvas.Brush.Color := Get508CompliantColor(clbtnFace);
grdChecks.Canvas.Font.Style := [fsBold];
end;
//change commented out code to handle different font color this code may not be needed anymore
if (format = '') and (ARow > 0) then
grdchecks.Canvas.Font.Color := Get508CompliantColor(clBlue)
else
grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlack);
if cdl = '1' then grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlue);
//controls highlighting cell when focused in on the cell
if State = [gdSelected..gdFocused] then
begin
isSelected := true; //use to control colors for high order checks
grdChecks.Canvas.Font.Color := Get508CompliantColor(clWhite);
grdChecks.Canvas.Brush.Color := clHighlight;
grdChecks.Canvas.Font.Color := clHighlightText;
grdChecks.Canvas.Font.Style := [fsBold];
grdChecks.Canvas.MoveTo(Rect.Left,Rect.top);
end
//if not an order than blanked out lines seperating the order check
else if (format = 'I') then
begin
if (Arow < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, Arow + 1], U, 2) = 'O') then IsBelowOrder := True
else IsBelowOrder := False;
grdChecks.Canvas.MoveTo(Rect.Left,Rect.Bottom);
grdChecks.Canvas.Pen.Color := Get508CompliantColor(clwhite);
grdChecks.Canvas.LineTo(Rect.Left, Rect.Top);
grdChecks.Canvas.LineTo(Rect.Right, Rect.Top);
grdChecks.Canvas.LineTo(Rect.Right, Rect.Bottom);
if (isBelowOrder = False) or (ARow = (grdChecks.RowCount -1)) then grdChecks.Canvas.LineTo(Rect.left, Rect.Bottom);
end;
Str:= grdChecks.Cells[ACol, ARow];
//determine if the cell needs to wrap
if ACol = 1 then Wrap := true
else wrap := false;
//Blank out existing Cell to prevent overlap after resize
grdChecks.Canvas.FillRect(Rect);
//get existing cell
DrawRect:= Rect;
if (ACol = 0) and (format = 'O') and (ARow > 0) then
begin
if Piece(grdChecks.Cells[2, ARow], U, 4) = '' then
begin
DrawRect.Bottom := DrawRect.Bottom + FontHeightPixel(Font.Handle) + 5;
setPiece(temp, U, 4, 'R');
grdChecks.Cells[2, ARow] := temp;
end;
if GetCheckState(grdChecks, ACol, ARow) = True then chkState := DFCS_CHECKED
else chkState := DFCS_BUTTONCHECK;
chkRect := CheckBoxRect(DrawRect);
DrawFrameControl(grdChecks.Canvas.Handle, chkRect, DFC_BUTTON, chkState);
DrawText(grdChecks.Canvas.Handle, PChar('Cancel?'), length('Cancel?'), DrawRect, DT_SINGLELINE or DT_Top or DT_Center);
if ((DrawRect.Bottom - DrawRect.Top) > grdChecks.RowHeights[ARow]) or
((DrawRect.Bottom - DrawRect.Top) < grdChecks.RowHeights[ARow]) then
begin
grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
end;
end;
//If order check than indent the order check text
if (ACol = 1) and (format = 'I') then DrawRect.Left := DrawRect.Left + 10;
//colorRect use to create Rect for Order Check Label
colorRect := DrawRect;
if Wrap then
begin
if (cdl = '1') and (format = 'I') then
begin
if isSelected = false then
begin
grdChecks.Canvas.Font.Color := Get508CompliantColor(clRed);
grdChecks.Canvas.Font.Style := [fsBold];
end;
//determine rect size for order check label
DrawText(grdChecks.Canvas.Handle, PChar(colorText), length(colorText), colorRect, dt_calcrect or dt_wordbreak);
DrawRect.Top := ColorRect.Bottom;
//determine rect size for order check text
DrawText(grdChecks.Canvas.Handle, PChar(str), length(str), DrawRect, dt_calcrect or dt_wordbreak);
str := copy(str, length(colorText + CRLF) + 1, length(str));
if isSelected = false then
begin
grdChecks.Canvas.Font.Color := Get508CompliantColor(clblue);
grdChecks.Canvas.Font.Style := [];
end;
end
//determine size for non-high order check text
else DrawText(grdChecks.Canvas.Handle, PChar(str), length(str), DrawRect, dt_calcrect or dt_wordbreak);
DrawRect.Bottom := DrawRect.Bottom + 2;
//Resize the Cell height if the height does not match the Rect Height
if ((DrawRect.Bottom - DrawRect.Top) > grdChecks.RowHeights[ARow]) then
begin
grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
end
else
begin
//if cell doesn't need to grow reset the cell
DrawRect.Right:= Rect.Right;
if (cdl = '1') and (format = 'I') then
begin
//DrawRect.Top := ColorRect.Bottom;
if isSelected = false then
begin
grdChecks.Canvas.Font.Color := Get508CompliantColor(clRed);
grdChecks.Canvas.Font.Style := [fsBold];
end;
DrawText(grdChecks.Canvas.Handle, PChar(colorText), length(colorText), colorRect, dt_wordbreak);
if isSelected = false then
begin
grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlue);
grdChecks.Canvas.Font.Style := [];
end;
end;
DrawText(grdChecks.Canvas.Handle, PChar(Str), length(Str), DrawRect, dt_wordbreak);
//reset height
if format = 'I' then grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
end;
end
else
//if not wrap than grow just draw the cell
DrawText(grdChecks.Canvas.Handle, PChar(Str), length(Str), DrawRect, dt_wordbreak);
end;
procedure TfrmOCSession.grdchecksEnter(Sender: TObject);
begin
inherited;
if ScreenReaderActive then
begin
grdChecks.Row := 1;
grdChecks.Col := 0;
GetScreenReader.Speak('Navigate through the grid to reviews the orders and the order checks');
if GetCheckState(grdchecks, 0, 1) = true then
GetScreenReader.Speak('Cancel checkbox is checked press spacebar to uncheck it')
else GetScreenReader.Speak('Cancel checkbox Not Checked press spacebar to check it to cancel the ' + grdChecks.Cells[1,1] + ' Order');
end;
grdChecks.Row := 1;
grdChecks.Col := 0;
end;
procedure TfrmOCSession.grdchecksKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if key = VK_TAB then
begin
if ssCtrl in Shift then
begin
if txtJustify.Visible = TRUE then ActiveControl := txtJustify
else ActiveControl := cmdContinue;
Key := 0;
Exit;
end;
end;
if grdchecks.Col = 0 then
begin
Case Key of
VK_Tab:
begin
if (ssShift in Shift) and (grdChecks.Row > 1) then
begin
grdChecks.Col := 1;
grdChecks.Row := grdChecks.Row - 1;
end;
end;
VK_Space:
begin
if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then
begin
if GetCheckState(grdChecks, 2, grdChecks.Row) = True then
SetCheckState(grdChecks, 2, grdChecks.Row, False)
else SetCheckState(grdChecks, 2, grdChecks.Row, True);
if ScreenReaderActive then
begin
if GetCheckState(grdchecks, 0, grdChecks.Row) = true then
GetScreenReader.Speak('Cancel checkbox checked')
else GetScreenReader.Speak('Cancel checkbox unChecked');
end;
end;
end;
(* VK_Down:
begin
if (grdChecks.Row < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, grdChecks.Row + 1], U, 2) <> 'O') then
begin
for I := grdChecks.Row + 1 to grdChecks.RowCount do
begin
if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
else
begin
grdChecks.Row := i;
exit;
end;
end;
end;
end;
VK_Up:
Begin
if ((grdChecks.Row - 1) > 1) and (Piece(grdChecks.Cells[2, grdChecks.Row - 1], U, 2) <> 'O') then
begin
for i := grdChecks.Row - 1 downto 0 do
begin
if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
else
begin
grdChecks.Row := i;
exit;
end;
end;
end;
End; *)
End;
end;
if grdChecks.Col = 1 then
begin
// needed to add control for tab key to handle the blank cells that should not have focus.
if key = VK_Tab then
begin
if ssShift in Shift then
begin
if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then grdChecks.Col := 0
else if grdChecks.Row > 1 then
begin
grdChecks.Col := 1;
grdChecks.Row := grdChecks.Row - 1;
end;
end
else
begin
if grdChecks.Row = (grdChecks.RowCount - 1) then
begin
if ScreenReaderActive = True then ActiveControl := memNote
else if txtJustify.Visible = TRUE then ActiveControl := txtJustify
else ActiveControl := cmdContinue;
Key := 0;
end
else
begin
grdChecks.Row := grdChecks.Row + 1;
if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then grdChecks.Col := 0
else grdChecks.Col := 2;
end;
end;
Key := 0;
end;
end;
end;
procedure TfrmOCSession.grdchecksMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Row, Col: integer;
begin
inherited;
grdChecks.MouseToCell(X, Y, Col, Row);
if Col <> 0 then exit;
if Piece(grdChecks.Cells[2,row], U, 2) <> 'O' then exit;
if InCheckBox(grdChecks, X, Y, Col, Row) = false then exit;
if GetCheckState(grdChecks, Col, Row) = True then SetCheckState(grdChecks, Col, Row, False)
else SetCheckState(grdChecks, Col, Row, True);
end;
procedure TfrmOCSession.grdchecksMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
acol , arow: integer;
//P : Tpoint;
//Rect: TRect;
begin
//Rect := grdChecks.CellRect(ACol, ARow);
//P.X := Rect.Left;
//P.Y := Rect.Top;
grdChecks.MouseToCell(X,y,acol , arow);
//check to see if hint should show
if ARow > grdChecks.RowCount then Exit;
if ACol <> 1 then exit;
if grdChecks.RowHeights[Arow] < grdChecks.Height then Exit;
grdChecks.Hint := grdChecks.Cells[ACol, ARow];
Application.HintHidePause := 20000; //20 Sec
if grdChecks.Hint <> '' then grdCHecks.ShowHint := true;
//Application.HintColor := clYellow;
//Application.ActivateHint(P);
end;
procedure TfrmOCSession.grdchecksMouseWheelDown(Sender: TObject;
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
inherited;
(* if grdChecks.Col = 0 then
begin
if (grdChecks.Row < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, grdChecks.Row + 1], U, 2) <> 'O') then
begin
for I := grdChecks.Row + 1 to grdChecks.RowCount do
begin
if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
else
begin
grdChecks.Row := i;
exit;
end;
end;
end;
end; *)
end;
procedure TfrmOCSession.grdchecksMouseWheelUp(Sender: TObject;
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
inherited;
(* if grdChecks.Col = 0 then
begin
if ((grdChecks.Row - 1) > 1) and (Piece(grdChecks.Cells[2, grdChecks.Row - 1], U, 2) <> 'O') then
begin
for i := grdChecks.Row - 1 downto 0 do
begin
if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
else
begin
grdChecks.Row := i;
exit;
end;
end;
end;
end; *)
end;
procedure TfrmOCSession.grdchecksSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
inherited;
CanSelect := True;
if ARow = 0 then CanSelect := false
else if (ACol = 2) then CanSelect := False
else if (ACol = 1) and (grdChecks.Cells[Acol, Arow] = '') then CanSelect := False;
//else if (ACol = 0) and (Piece(grdChecks.cells[2,ARow], U, 2) <> 'O') then CanSelect := false;
if (CanSelect = True) and (ACol = 0) and (Piece(grdChecks.cells[2,ARow], U, 2) = 'O') and (ScreenReaderActive) then
begin
if GetCheckState(grdchecks, ACol, ARow) = true then
GetScreenReader.Speak('Cancel checkbox is checked press spacebar to uncheck it')
else GetScreenReader.Speak('Cancel checkbox Not Checked press spacebar to check it to cancel the ' + grdChecks.Cells[1,Arow] + ' Order');
end;
end;
procedure TfrmOCSession.GridDeleteRow(RowNumber: Integer; Grid: TstringGrid);
var
i: Integer;
begin
Grid.Row := RowNumber;
if (Grid.Row = Grid.RowCount - 1) then
{ On the last row}
Grid.RowCount := Grid.RowCount - 1
else
begin
{ Not the last row}
for i := RowNumber to Grid.RowCount - 1 do
Grid.Rows[i] := Grid.Rows[i + 1];
Grid.RowCount := Grid.RowCount - 1;
end;
end;
function TfrmOCSession.InCheckBox(Grid: TStringGrid; X, Y, ACol,
ARow: integer): boolean;
var
Rect: TRect;
begin
Result := False;
Rect := CheckBoxRect(grid.CellRect(ACol, ARow));
if Y < Rect.Top then Exit;
if Y > Rect.Bottom then Exit;
if X < Rect.Left then exit;
if X > Rect.Right then exit;
Result := True;
end;
function TfrmOCSession.GetCheckState(grid: TStringGrid; ACol, ARow: integer): boolean;
begin
if Piece(grid.Cells[2, ARow], U, 3) = '1' then Result := True
else Result := false;
end;
procedure TfrmOCSession.FormResize(Sender: TObject); procedure TfrmOCSession.FormResize(Sender: TObject);
begin begin
//TfrmAutoSz has defect must call inherited Resize for the resize to function. //TfrmAutoSz has defect must call inherited Resize for the resize to function.
inherited; inherited;
grdChecks.ColWidths[0] := round(grdChecks.Width * 0.08);
grdChecks.ColWidths[1] := round(grdChecks.Width * 0.88); //Order Text
grdChecks.ColWidths[2] := 0; //OrderID^Format^IsCheck
grdChecks.tabStops[2] := false;
if grdChecks.RowCount > 1 then grdChecks.Refresh;
self.pnlBottom.Top := self.pnlTop.Top + self.pnlTop.Height;
end; end;
procedure TfrmOCSession.txtJustifyKeyDown(Sender: TObject; var Key: Word; procedure TfrmOCSession.txtJustifyKeyDown(Sender: TObject; var Key: Word;
@ -351,4 +932,20 @@ begin
memNote.SelStart := 0; memNote.SelStart := 0;
end; end;
procedure TfrmOCSession.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_F4) and (ssAlt in Shift) then Key := 0;
end;
procedure TfrmOCSession.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
inherited;
if self.grdchecks.Focused = false then
begin
end;
end;
end. end.

4
CPRS-Chart/Orders/fODAuto.pas
View File

@ -60,6 +60,9 @@ begin
else else
CheckBoilerplate4Fields(tmp, cptn); CheckBoilerplate4Fields(tmp, cptn);
if WasTemplateDialogCanceled then AnErrMsg := 'The Auto-Accept Quick Order cannot be saved since the template was cancelled.';
if tmp <> '' then if tmp <> '' then
Responses.Update('COMMENT', 1, TX_WPTYPE, tmp) Responses.Update('COMMENT', 1, TX_WPTYPE, tmp)
else else
@ -86,6 +89,7 @@ begin
FillerID := FillerIDForDialog(DialogIEN); FillerID := FillerIDForDialog(DialogIEN);
IdentifyDialog(DialogNames, DialogIEN); IdentifyDialog(DialogNames, DialogIEN);
Responses.Dialog := DialogNames.BaseName; // loads formatting info Responses.Dialog := DialogNames.BaseName; // loads formatting info
Responses.DialogDisplayName := DialogNames.Display;
StatusText(''); StatusText('');
end; end;

362
CPRS-Chart/Orders/fODBBank.dfm
View File

@ -1,16 +1,24 @@
inherited frmODBBank: TfrmODBBank inherited frmODBBank: TfrmODBBank
Left = 409 Left = 409
Top = 244 Top = 244
HorzScrollBar.Range = 0 Width = 700
VertScrollBar.Range = 0 Height = 626
AutoScroll = True
Caption = 'Blood Component and Diagnostic Test Order Form' Caption = 'Blood Component and Diagnostic Test Order Form'
ClientHeight = 600 OnShow = FormShow
ClientWidth = 709 ExplicitWidth = 700
ExplicitWidth = 717 ExplicitHeight = 626
ExplicitHeight = 634
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pnlComments: TPanel [0] object Splitter1: TSplitter [0]
Left = 0
Top = 0
Width = 692
Height = 2
Cursor = crVSplit
Align = alTop
end
object pnlComments: TPanel [1]
Left = 12 Left = 12
Top = 25 Top = 25
Width = 534 Width = 534
@ -50,35 +58,38 @@ inherited frmODBBank: TfrmODBBank
end end
end end
inherited memOrder: TCaptionMemo inherited memOrder: TCaptionMemo
Left = 0 Left = 4
Top = 399 Top = 503
Width = 449 Width = 449
Height = 59 Height = 59
Visible = False Visible = False
ExplicitLeft = 0 ExplicitLeft = 4
ExplicitTop = 399 ExplicitTop = 503
ExplicitWidth = 449 ExplicitWidth = 449
ExplicitHeight = 59 ExplicitHeight = 59
end end
object pgeProduct: TPageControl [2] object pgeProduct: TPageControl [3]
Left = 0 Left = 0
Top = 0 Top = 2
Width = 709 Width = 692
Height = 393 Height = 497
ActivePage = TabDiag ActivePage = TabDiag
Align = alTop Align = alTop
TabOrder = 6 TabOrder = 4
TabStop = False
OnChange = pgeProductChange OnChange = pgeProductChange
object TabInfo: TTabSheet object TabInfo: TTabSheet
Caption = 'Patient Information' Caption = 'Patient Information'
ImageIndex = 3 ImageIndex = 3
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object edtInfo: TCaptionRichEdit object edtInfo: TCaptionRichEdit
Left = 0 Left = 0
Top = 8 Top = 0
Width = 556 Width = 684
Height = 337 Height = 469
TabStop = False Align = alClient
BevelInner = bvNone BevelInner = bvNone
BevelOuter = bvNone BevelOuter = bvNone
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -90,6 +101,7 @@ inherited frmODBBank: TfrmODBBank
ReadOnly = True ReadOnly = True
ScrollBars = ssBoth ScrollBars = ssBoth
TabOrder = 0 TabOrder = 0
WordWrap = False
Caption = 'Patient Info' Caption = 'Patient Info'
end end
end end
@ -97,7 +109,7 @@ inherited frmODBBank: TfrmODBBank
Caption = 'Blood Bank Orders' Caption = 'Blood Bank Orders'
ImageIndex = 2 ImageIndex = 2
object lblReqComment: TOROffsetLabel object lblReqComment: TOROffsetLabel
Left = 298 Left = 300
Top = 25 Top = 25
Width = 108 Width = 108
Height = 37 Height = 37
@ -108,9 +120,9 @@ inherited frmODBBank: TfrmODBBank
end end
object pnlFields: TPanel object pnlFields: TPanel
Left = 0 Left = 0
Top = 163 Top = 145
Width = 701 Width = 684
Height = 99 Height = 210
Hint = 'Data entered into these fields apply to the entire order.' Hint = 'Data entered into these fields apply to the entire order.'
Align = alTop Align = alTop
BevelEdges = [] BevelEdges = []
@ -119,9 +131,9 @@ inherited frmODBBank: TfrmODBBank
ShowHint = True ShowHint = True
TabOrder = 2 TabOrder = 2
object lblDiagComment: TOROffsetLabel object lblDiagComment: TOROffsetLabel
Left = 257 Left = 0
Top = 35 Top = 128
Width = 46 Width = 62
Height = 15 Height = 15
Caption = 'Comment' Caption = 'Comment'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -136,8 +148,8 @@ inherited frmODBBank: TfrmODBBank
WordWrap = True WordWrap = True
end end
object lblUrgency: TLabel object lblUrgency: TLabel
Left = 8 Left = 0
Top = -2 Top = -1
Width = 44 Width = 44
Height = 13 Height = 13
Caption = 'Urgency*' Caption = 'Urgency*'
@ -149,11 +161,11 @@ inherited frmODBBank: TfrmODBBank
ParentFont = False ParentFont = False
end end
object lblReason: TLabel object lblReason: TLabel
Left = 10 Left = 0
Top = 35 Top = 40
Width = 99 Width = 95
Height = 13 Height = 13
Caption = 'Reason for Request*' Caption = 'Reason for Request'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
@ -162,14 +174,15 @@ inherited frmODBBank: TfrmODBBank
ParentFont = False ParentFont = False
end end
object lblSurgery: TLabel object lblSurgery: TLabel
Left = 115 Left = 117
Top = -2 Top = 0
Width = 36 Width = 36
Height = 13 Height = 13
Hint = Hint =
'Enter the name of the surgical procedure that this request is fo' + 'Enter the name of the surgical procedure that this request is fo' +
'r.' 'r.'
Caption = 'Surgery' Caption = 'Surgery'
Enabled = False
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
@ -178,15 +191,45 @@ inherited frmODBBank: TfrmODBBank
ParentFont = False ParentFont = False
end end
object lblRequiredField: TLabel object lblRequiredField: TLabel
Left = 10 Left = 398
Top = 75 Top = 38
Width = 122 Width = 122
Height = 13 Height = 13
Caption = '* Indicates a required field' Caption = '* Indicates a required field'
end end
object lblTNS: TLabel
Left = 270
Top = 0
Width = 14
Height = 13
Caption = 'tns'
Color = clActiveBorder
Font.Charset = DEFAULT_CHARSET
Font.Color = clMaroon
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentColor = False
ParentFont = False
Visible = False
end
object lblNoBloodReq: TLabel
Left = 341
Top = 21
Width = 176
Height = 13
Caption = 'No Blood Required for this Procedure'
Font.Charset = DEFAULT_CHARSET
Font.Color = clMaroon
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
Visible = False
end
object cboUrgency: TORComboBox object cboUrgency: TORComboBox
Left = 12 Left = 4
Top = 12 Top = 14
Width = 98 Width = 98
Height = 21 Height = 21
Style = orcsDropDown Style = orcsDropDown
@ -216,8 +259,8 @@ inherited frmODBBank: TfrmODBBank
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object chkConsent: TCheckBox object chkConsent: TCheckBox
Left = 351 Left = 529
Top = 10 Top = 92
Width = 112 Width = 112
Height = 17 Height = 17
Hint = 'Informed Consent Signed On Chart?' Hint = 'Informed Consent Signed On Chart?'
@ -236,8 +279,8 @@ inherited frmODBBank: TfrmODBBank
OnClick = chkConsentClick OnClick = chkConsentClick
end end
object cboSurgery: TORComboBox object cboSurgery: TORComboBox
Left = 115 Left = 117
Top = 12 Top = 14
Width = 218 Width = 218
Height = 21 Height = 21
Style = orcsDropDown Style = orcsDropDown
@ -268,11 +311,11 @@ inherited frmODBBank: TfrmODBBank
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboReasons: TORComboBox object cboReasons: TORComboBox
Left = 12 Left = 4
Top = 51 Top = 55
Width = 239 Width = 525
Height = 21 Height = 74
Style = orcsDropDown Style = orcsSimple
AutoSelect = True AutoSelect = True
Color = clWindow Color = clWindow
DropDownCount = 8 DropDownCount = 8
@ -292,10 +335,10 @@ inherited frmODBBank: TfrmODBBank
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object memDiagComment: TRichEdit object memDiagComment: TRichEdit
Left = 257 Left = 4
Top = 51 Top = 144
Width = 250 Width = 525
Height = 48 Height = 60
TabOrder = 4 TabOrder = 4
OnChange = memDiagCommentChange OnChange = memDiagCommentChange
end end
@ -303,32 +346,16 @@ inherited frmODBBank: TfrmODBBank
object pnlSelect: TPanel object pnlSelect: TPanel
Left = 0 Left = 0
Top = 35 Top = 35
Width = 701 Width = 684
Height = 128 Height = 110
Align = alTop Align = alTop
BevelEdges = [] BevelEdges = []
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
object lblTNS: TLabel
Left = 298
Top = 109
Width = 14
Height = 13
Caption = 'tns'
Color = clActiveBorder
Font.Charset = DEFAULT_CHARSET
Font.Color = clMaroon
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentColor = False
ParentFont = False
Visible = False
end
object pnlDiagnosticTests: TGroupBox object pnlDiagnosticTests: TGroupBox
Left = 256 Left = 266
Top = 0 Top = 0
Width = 267 Width = 256
Height = 110 Height = 110
Caption = 'Diagnostic Tests' Caption = 'Diagnostic Tests'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -338,6 +365,9 @@ inherited frmODBBank: TfrmODBBank
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 1 TabOrder = 1
OnClick = pnlDiagnosticTestsClick
OnEnter = pnlDiagnosticTestsEnter
OnExit = pnlDiagnosticTestsExit
object lblCollType: TLabel object lblCollType: TLabel
Left = 13 Left = 13
Top = 33 Top = 33
@ -354,9 +384,9 @@ inherited frmODBBank: TfrmODBBank
object lblCollTime: TLabel object lblCollTime: TLabel
Left = 12 Left = 12
Top = 70 Top = 70
Width = 104 Width = 100
Height = 13 Height = 13
Caption = 'Collection Date/Time*' Caption = 'Collection Date/Time'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
@ -364,38 +394,56 @@ inherited frmODBBank: TfrmODBBank
Font.Style = [] Font.Style = []
ParentFont = False ParentFont = False
end end
object cmdImmedColl: TSpeedButton
Left = 148
Top = 89
Width = 21
Height = 11
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
Glyph.Data = {
D6000000424DD60000000000000076000000280000000C0000000C0000000100
0400000000006000000000000000000000001000000010000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
0000333333333333000033333333333300003333333333330000300330033003
0000300330033003000033333333333300003333333333330000333333333333
0000333333333333000033333333333300003333333333330000}
ParentFont = False
ParentShowHint = False
ShowHint = False
OnClick = cmdImmedCollClick
end
object pnlCollTimeButton: TKeyClickPanel object pnlCollTimeButton: TKeyClickPanel
Left = 85 Left = 178
Top = 89 Top = 82
Width = 20 Width = 21
Height = 13 Height = 21
BevelOuter = bvNone BevelOuter = bvNone
Caption = 'Select collection time' Caption = 'Select collection time'
TabOrder = 5 TabOrder = 5
TabStop = True TabStop = True
object cmdImmedColl: TSpeedButton
Left = 0
Top = 0
Width = 21
Height = 21
Align = alClient
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
Glyph.Data = {
D6000000424DD60000000000000076000000280000000C0000000C0000000100
0400000000006000000000000000000000001000000010000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
0000333333333333000033333333333300003333333333330000300330033003
0000300330033003000033333333333300003333333333330000333333333333
0000333333333333000033333333333300003333333333330000}
ParentFont = False
ParentShowHint = False
ShowHint = False
OnClick = cmdImmedCollClick
end
end
object calCollTime: TORDateBox
Left = 12
Top = 82
Width = 165
Height = 21
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 4
OnChange = calCollTimeChange
OnEnter = calCollTimeEnter
DateOnly = False
RequireTime = False
end end
object cboAvailTest: TORComboBox object cboAvailTest: TORComboBox
Left = 13 Left = 13
@ -416,7 +464,7 @@ inherited frmODBBank: TfrmODBBank
ItemTipColor = clWindow ItemTipColor = clWindow
ItemTipEnable = True ItemTipEnable = True
ListItemsOnly = False ListItemsOnly = False
LongList = True LongList = False
LookupPiece = 0 LookupPiece = 0
MaxLength = 0 MaxLength = 0
ParentFont = False ParentFont = False
@ -425,15 +473,16 @@ inherited frmODBBank: TfrmODBBank
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 0 TabOrder = 0
TabStop = True TabStop = True
OnClick = cboAvailTestSelect
OnEnter = cboAvailTestEnter
OnExit = cboAvailTestExit OnExit = cboAvailTestExit
OnMouseClick = cboAvailTestSelect
OnNeedData = cboAvailTestNeedData OnNeedData = cboAvailTestNeedData
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboCollType: TORComboBox object cboCollType: TORComboBox
Left = 12 Left = 12
Top = 46 Top = 46
Width = 165 Width = 197
Height = 21 Height = 21
Style = orcsDropDown Style = orcsDropDown
AutoSelect = True AutoSelect = True
@ -458,6 +507,8 @@ inherited frmODBBank: TfrmODBBank
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 1 TabOrder = 1
OnChange = cboCollTypeChange OnChange = cboCollTypeChange
OnClick = cboCollTypeClick
OnEnter = cboCollTypeEnter
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboCollTime: TORComboBox object cboCollTime: TORComboBox
@ -488,24 +539,9 @@ inherited frmODBBank: TfrmODBBank
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 2 TabOrder = 2
OnChange = cboCollTimeChange OnChange = cboCollTimeChange
OnEnter = cboCollTimeEnter
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object calCollTime: TORDateBox
Left = 12
Top = 82
Width = 165
Height = 21
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 3
OnChange = calCollTimeChange
DateOnly = False
RequireTime = False
end
object txtImmedColl: TCaptionEdit object txtImmedColl: TCaptionEdit
Left = 12 Left = 12
Top = 82 Top = 82
@ -513,29 +549,34 @@ inherited frmODBBank: TfrmODBBank
Height = 21 Height = 21
Color = clBtnFace Color = clBtnFace
ReadOnly = True ReadOnly = True
TabOrder = 4 TabOrder = 3
Text = 'txtImmedColl' OnEnter = txtImmedCollEnter
end end
end end
object pnlBloodComponents: TGroupBox object pnlBloodComponents: TGroupBox
Left = 4 Left = 4
Top = 0 Top = 0
Width = 246 Width = 256
Height = 110 Height = 110
Caption = 'Blood Components' Caption = 'Blood Components'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
Font.Name = 'MS Sans Serif' Font.Name = 'MS Sans Serif'
Font.Style = [fsBold] Font.Style = [fsBold]
ParentColor = False
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
OnClick = pnlBloodComponentsClick
OnEnter = pnlBloodComponentsEnter
OnExit = pnlBloodComponentsExit
object lblQuantity: TLabel object lblQuantity: TLabel
Left = 198 Left = 198
Top = 0 Top = 0
Width = 43 Width = 39
Height = 13 Height = 13
Caption = 'Quantity*' Caption = 'Quantity'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
@ -559,9 +600,9 @@ inherited frmODBBank: TfrmODBBank
object lblWanted: TLabel object lblWanted: TLabel
Left = 7 Left = 7
Top = 70 Top = 70
Width = 96 Width = 92
Height = 13 Height = 13
Caption = 'Date/Time Wanted*' Caption = 'Date/Time Wanted'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
@ -597,7 +638,7 @@ inherited frmODBBank: TfrmODBBank
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 0 TabOrder = 0
TabStop = True TabStop = True
OnChange = cboAvailCompChange OnEnter = cboAvailCompEnter
OnExit = cboAvailCompExit OnExit = cboAvailCompExit
OnMouseClick = cboAvailCompSelect OnMouseClick = cboAvailCompSelect
OnNeedData = cboAvailCompNeedData OnNeedData = cboAvailCompNeedData
@ -622,7 +663,7 @@ inherited frmODBBank: TfrmODBBank
object cboModifiers: TORComboBox object cboModifiers: TORComboBox
Left = 11 Left = 11
Top = 46 Top = 46
Width = 133 Width = 181
Height = 21 Height = 21
Style = orcsDropDown Style = orcsDropDown
AutoSelect = True AutoSelect = True
@ -646,12 +687,13 @@ inherited frmODBBank: TfrmODBBank
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 2 TabOrder = 2
OnChange = cboModifiersChange OnChange = cboModifiersChange
OnEnter = cboModifiersEnter
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object calWantTime: TORDateBox object calWantTime: TORDateBox
Left = 11 Left = 11
Top = 82 Top = 82
Width = 149 Width = 181
Height = 21 Height = 21
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -661,6 +703,7 @@ inherited frmODBBank: TfrmODBBank
ParentFont = False ParentFont = False
TabOrder = 3 TabOrder = 3
OnChange = calWantTimeChange OnChange = calWantTimeChange
OnEnter = calWantTimeEnter
DateOnly = False DateOnly = False
RequireTime = False RequireTime = False
end end
@ -669,7 +712,7 @@ inherited frmODBBank: TfrmODBBank
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
Left = 0 Left = 0
Top = 0 Top = 0
Width = 701 Width = 684
Height = 35 Height = 35
Align = alTop Align = alTop
Caption = ' Personal Quick Orders' Caption = ' Personal Quick Orders'
@ -683,7 +726,7 @@ inherited frmODBBank: TfrmODBBank
object cboQuick: TORComboBox object cboQuick: TORComboBox
Left = 15 Left = 15
Top = 11 Top = 11
Width = 488 Width = 508
Height = 21 Height = 21
Style = orcsDropDown Style = orcsDropDown
AutoSelect = True AutoSelect = True
@ -706,9 +749,9 @@ inherited frmODBBank: TfrmODBBank
end end
object pnlSelectedTests: TGroupBox object pnlSelectedTests: TGroupBox
Left = 0 Left = 0
Top = 262 Top = 355
Width = 701 Width = 684
Height = 112 Height = 109
Align = alTop Align = alTop
Caption = 'Selected Components and Tests' Caption = 'Selected Components and Tests'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -721,10 +764,9 @@ inherited frmODBBank: TfrmODBBank
Visible = False Visible = False
object lvSelectionList: TCaptionListView object lvSelectionList: TCaptionListView
Left = 5 Left = 5
Top = 12 Top = 15
Width = 417 Width = 430
Height = 91 Height = 91
Color = clBtnFace
Columns = < Columns = <
item item
AutoSize = True AutoSize = True
@ -750,7 +792,7 @@ inherited frmODBBank: TfrmODBBank
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
Font.Name = 'MS Sans Serif' Font.Name = 'MS Sans Serif'
Font.Style = [fsBold] Font.Style = []
ReadOnly = True ReadOnly = True
RowSelect = True RowSelect = True
ParentFont = False ParentFont = False
@ -761,7 +803,7 @@ inherited frmODBBank: TfrmODBBank
Caption = 'lvSelectionList' Caption = 'lvSelectionList'
end end
object btnRemove: TButton object btnRemove: TButton
Left = 428 Left = 450
Top = 37 Top = 37
Width = 75 Width = 75
Height = 21 Height = 21
@ -776,7 +818,7 @@ inherited frmODBBank: TfrmODBBank
OnClick = btnRemoveClick OnClick = btnRemoveClick
end end
object btnRemoveAll: TButton object btnRemoveAll: TButton
Left = 428 Left = 450
Top = 64 Top = 64
Width = 75 Width = 75
Height = 21 Height = 21
@ -794,11 +836,16 @@ inherited frmODBBank: TfrmODBBank
end end
object TabResults: TTabSheet object TabResults: TTabSheet
Caption = 'Lab Results' Caption = 'Lab Results'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object edtResults: TCaptionRichEdit object edtResults: TCaptionRichEdit
Left = -4 Left = 0
Top = 57 Top = 0
Width = 517 Width = 684
Height = 290 Height = 469
Align = alClient
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
@ -811,29 +858,31 @@ inherited frmODBBank: TfrmODBBank
end end
inherited cmdAccept: TButton inherited cmdAccept: TButton
Left = 455 Left = 455
Top = 399 Top = 503
Width = 75
TabOrder = 2 TabOrder = 2
Visible = False Visible = False
ExplicitLeft = 455 ExplicitLeft = 455
ExplicitTop = 399 ExplicitTop = 503
ExplicitWidth = 75
end end
inherited cmdQuit: TButton inherited cmdQuit: TButton
Left = 455 Left = 455
Top = 426 Top = 541
Width = 52 Width = 52
TabOrder = 3 TabOrder = 3
ExplicitLeft = 455 ExplicitLeft = 455
ExplicitTop = 426 ExplicitTop = 541
ExplicitWidth = 52 ExplicitWidth = 52
end end
inherited pnlMessage: TPanel inherited pnlMessage: TPanel
Left = 8 Left = 8
Top = 409 Top = 513
Width = 409 Width = 409
Height = 49 Height = 49
TabOrder = 1 TabOrder = 1
ExplicitLeft = 8 ExplicitLeft = 8
ExplicitTop = 409 ExplicitTop = 513
ExplicitWidth = 409 ExplicitWidth = 409
ExplicitHeight = 49 ExplicitHeight = 49
inherited memMessage: TRichEdit inherited memMessage: TRichEdit
@ -945,8 +994,7 @@ inherited frmODBBank: TfrmODBBank
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = cboReasons' 'Component = cboReasons'
'Text = Applies to entire order' 'Status = stsDefault')
'Status = stsOK')
( (
'Component = memDiagComment' 'Component = memDiagComment'
'Status = stsDefault') 'Status = stsDefault')
@ -957,16 +1005,16 @@ inherited frmODBBank: TfrmODBBank
'Component = cboCollTime' 'Component = cboCollTime'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = calWantTime' 'Component = txtImmedColl'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = calCollTime' 'Component = calCollTime'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = txtImmedColl' 'Component = pnlCollTimeButton'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = pnlCollTimeButton' 'Component = calWantTime'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object dlgLabCollTime: TORDateTimeDlg object dlgLabCollTime: TORDateTimeDlg

1908
CPRS-Chart/Orders/fODBBank.pas
View File

File diff suppressed because it is too large Load Diff

2
CPRS-Chart/Orders/fODBase.dfm
View File

@ -24,14 +24,12 @@ inherited frmODBase: TfrmODBase
Top = 194 Top = 194
Width = 430 Width = 430
Height = 48 Height = 48
TabStop = False
Color = clCream Color = clCream
Ctl3D = True Ctl3D = True
ParentCtl3D = False ParentCtl3D = False
ReadOnly = True ReadOnly = True
ScrollBars = ssVertical ScrollBars = ssVertical
TabOrder = 0 TabOrder = 0
Caption = 'Order'
end end
object cmdAccept: TButton [1] object cmdAccept: TButton [1]
Left = 442 Left = 442

77
CPRS-Chart/Orders/fODBase.pas
View File

@ -43,6 +43,7 @@ type
TResponses = class TResponses = class
private private
FDialog: string; FDialog: string;
FDialogDisplayName: string;
FResponseList: TList; FResponseList: TList;
FPrompts: TList; FPrompts: TList;
FCopyOrder: string; FCopyOrder: string;
@ -98,6 +99,7 @@ type
procedure Update(const APromptID: string; AnInstance: Integer; procedure Update(const APromptID: string; AnInstance: Integer;
const AnIValue, AnEValue: string); const AnIValue, AnEValue: string);
property Dialog: string read FDialog write SetDialog; property Dialog: string read FDialog write SetDialog;
property DialogDisplayName: string read FDialogDisplayName write FDialogDisplayName;
property DisplayGroup: Integer read FDisplayGroup write FDisplayGroup; property DisplayGroup: Integer read FDisplayGroup write FDisplayGroup;
property CopyOrder: string read FCopyOrder write SetCopyOrder; property CopyOrder: string read FCopyOrder write SetCopyOrder;
property EditOrder: string read FEditOrder; // write SetEditOrder; property EditOrder: string read FEditOrder; // write SetEditOrder;
@ -644,23 +646,35 @@ begin
if EditOrder <> '' then DupORIFN := EditOrder; if EditOrder <> '' then DupORIFN := EditOrder;
if CopyOrder <> '' then DupORIFN := CopyOrder; if CopyOrder <> '' then DupORIFN := CopyOrder;
//if {(CopyOrder <> '') or} (EditOrder <> '') then Exit; // only check new orders //if {(CopyOrder <> '') or} (EditOrder <> '') then Exit; // only check new orders
with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do with FResponseList do
if (PromptID = 'ORDERABLE') or (PromptID = 'ADDITIVE') then for i := 0 to FResponseList.Count - 1 do
begin
OrderableIEN := IValue;
TheInstance := Instance;
PkgPart := '';
if AFillerID = 'LR' then PkgPart := '^LR^' + IValueFor('SPECIMEN', TheInstance);
if (AFillerID = 'PSI') or (AFillerID = 'PSO') or (AFillerID = 'PSH')
then PkgPart := U + AFillerID + U + IValueFor('DRUG', TheInstance);
// was -- then PkgPart := '^PS^' + IValueFor('DRUG', TheInstance);
if AFillerID = 'PSIV' then
begin begin
if PromptID = 'ORDERABLE' then PkgPart := '^PSIV^B;' + IValueFor('VOLUME', TheInstance); with TResponse(Items[i]) do
if PromptID = 'ADDITIVE' then PkgPart := '^PSIV^A'; begin
if (PromptID = 'ORDERABLE') or (PromptID = 'ADDITIVE') then
begin
OrderableIEN := IValue;
TheInstance := Instance;
PkgPart := '';
if AFillerID = 'LR' then PkgPart := '^LR^' + IValueFor('SPECIMEN', TheInstance);
if (AFillerID = 'PSI') or (AFillerID = 'PSO') or (AFillerID = 'PSH') or (AFillerID = 'PSNV')
then PkgPart := U + AFillerID + U + IValueFor('DRUG', TheInstance);
// was -- then PkgPart := '^PS^' + IValueFor('DRUG', TheInstance);
if AFillerID = 'PSIV' then
begin
if PromptID = 'ORDERABLE' then PkgPart := '^PSIV^B;' + IValueFor('VOLUME', TheInstance);
if PromptID = 'ADDITIVE' then PkgPart := '^PSIV^A';
end;
AList.Add(OrderableIEN + PkgPart);
end;
//AGP IV CHANGES
if (AFillerID = 'PSI') or (AFillerID = 'PSO') or (AFillerID = 'PSH') or (AFillerID = 'PSIV') or (AFillerID = 'PSNV') then
begin
IF PromptID = 'COMMENT' then continue;
Alist.Add(AFillerID + U + PromptID + U + InttoStr(Instance) + U + IValueFor(PromptID, Instance) + U + EValueFor(PromptID, Instance));
end;
end; end;
AList.Add(OrderableIEN + PkgPart); end;
end;
AStartDtTm := IValueFor('START', 1); AStartDtTm := IValueFor('START', 1);
end; end;
@ -1137,6 +1151,13 @@ var
end; end;
ExpandOrderObjects(tmp, HasObjects); ExpandOrderObjects(tmp, HasObjects);
FOrderContainsObjects := FOrderContainsObjects or HasObjects; FOrderContainsObjects := FOrderContainsObjects or HasObjects;
if frmODBase.FAbortOrder then
begin
SetTemplateDialogCanceled(FALSE);
Exit;
end;
if IEN <> 0 then if IEN <> 0 then
begin begin
// template will execute on copy order if commented out (tried to eliminate for CSV v22, RV) // template will execute on copy order if commented out (tried to eliminate for CSV v22, RV)
@ -1154,6 +1175,8 @@ var
else else
CheckBoilerplate4Fields(tmp, cptn); CheckBoilerplate4Fields(tmp, cptn);
List.Text := tmp; List.Text := tmp;
if WasTemplateDialogCanceled then frmODBase.FAbortOrder := True;
end; end;
begin begin
@ -1300,6 +1323,8 @@ end;
procedure TfrmODBase.OrderMessage(const AMessage: string); procedure TfrmODBase.OrderMessage(const AMessage: string);
{Caller needs to set pnlMessage.TabOrder} {Caller needs to set pnlMessage.TabOrder}
begin begin
//TDP - Added pnlMessage.Caption for screen reader readability
pnlMessage.Caption := 'Informational Message.';
memMessage.Lines.SetText(PChar(AMessage)); memMessage.Lines.SetText(PChar(AMessage));
//begin CQ: 2640 //begin CQ: 2640
memMessage.SelStart := 0; // Put at first character memMessage.SelStart := 0; // Put at first character
@ -1322,6 +1347,7 @@ procedure TfrmODBase.SetupDialog(OrderAction: Integer; const ID: string);
begin begin
FOrderAction := OrderAction; FOrderAction := OrderAction;
FAbortOrder := False; FAbortOrder := False;
SetTemplateDialogCanceled(False); //wat/jh CQ 20061
case OrderAction of case OrderAction of
ORDER_NEW: {nothing}; ORDER_NEW: {nothing};
ORDER_EDIT: Responses.SetEditOrder(ID); ORDER_EDIT: Responses.SetEditOrder(ID);
@ -1467,7 +1493,7 @@ begin
try try
StatusText('Order Checking...'); StatusText('Order Checking...');
Responses.BuildOCItems(OIList, StartDtTm, FillerID); Responses.BuildOCItems(OIList, StartDtTm, FillerID);
OrderChecksOnAccept(Responses.OrderChecks, FillerID, StartDtTm, OIList, DupORIFN); OrderChecksOnAccept(Responses.OrderChecks, FillerID, StartDtTm, OIList, DupORIFN,'0');
DupORIFN := ''; DupORIFN := '';
StatusText(''); StatusText('');
Result := AcceptOrderWithChecks(Responses.OrderChecks); Result := AcceptOrderWithChecks(Responses.OrderChecks);
@ -1489,8 +1515,8 @@ var
//thisSourceOrder: TOrder; //thisSourceOrder: TOrder;
begin begin
Result := True; Result := True;
Validate(ErrMsg);
IsDelayOrder := False; IsDelayOrder := False;
Validate(ErrMsg);
if Length(ErrMsg) > 0 then if Length(ErrMsg) > 0 then
begin begin
InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK); InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
@ -1499,6 +1525,12 @@ begin
end; end;
if not AcceptOrderChecks then if not AcceptOrderChecks then
begin begin
//added code to shut CPRS down without access violations if the fOCAccept is open when timing out.
if frmFrame.TimedOut then
begin
Result := False;
Exit;
end;
if AskAnotherOrder(DialogIEN) then if AskAnotherOrder(DialogIEN) then
InitDialog // ClearDialogControls is in InitDialog InitDialog // ClearDialogControls is in InitDialog
else else
@ -1540,8 +1572,9 @@ begin
then CanSign := CH_SIGN_YES then CanSign := CH_SIGN_YES
else CanSign := CH_SIGN_NA; else CanSign := CH_SIGN_NA;
if NewOrder.Signature = OSS_NOT_REQUIRE then CanSign := CH_SIGN_NA; if NewOrder.Signature = OSS_NOT_REQUIRE then CanSign := CH_SIGN_NA;
if NewOrder.EventPtr <> '' then IsDelayOrder := True; if (NewOrder.EventPtr <> '') and (GetEventDefaultDlg(responses.FEventIFN) <> InttoStr(Responses.QuickOrder)) then
Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False,IsDelayOrder); IsDelayOrder := True;
Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False, IsDelayOrder);
UBAGlobals.TargetOrderID := NewOrder.ID; UBAGlobals.TargetOrderID := NewOrder.ID;
@ -1710,7 +1743,11 @@ begin
inherited; inherited;
//self.Responses.Cancel := False; //self.Responses.Cancel := False;
if User.NoOrdering then Exit; if User.NoOrdering then Exit;
if FAbortOrder then exit; if FAbortOrder then
begin
SetTemplateDialogCanceled(FALSE);
exit;
end;
if FOrderAction in [ORDER_EDIT, ORDER_COPY] then Exit; // don't invoke verify dialog if FOrderAction in [ORDER_EDIT, ORDER_COPY] then Exit; // don't invoke verify dialog
if FOrderAction = ORDER_QUICK then Exit; // should this be here?? if FOrderAction = ORDER_QUICK then Exit; // should this be here??
if frmFrame.ContextChanging then if frmFrame.ContextChanging then

22
CPRS-Chart/Orders/fODDiet.dfm
View File

@ -21,6 +21,10 @@ inherited frmODDiet: TfrmODDiet
OnChanging = nbkDietChanging OnChanging = nbkDietChanging
object pgeDiet: TTabSheet object pgeDiet: TTabSheet
Caption = 'Diet' Caption = 'Diet'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object lblDietAvail: TLabel object lblDietAvail: TLabel
Left = 4 Left = 4
Top = 0 Top = 0
@ -434,6 +438,10 @@ inherited frmODDiet: TfrmODDiet
end end
object pgeTubefeeding: TTabSheet object pgeTubefeeding: TTabSheet
Caption = 'Tubefeeding' Caption = 'Tubefeeding'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object lblTFProductList: TLabel object lblTFProductList: TLabel
Left = 4 Left = 4
Top = 0 Top = 0
@ -583,7 +591,7 @@ inherited frmODDiet: TfrmODDiet
Height = 21 Height = 21
Style = csDropDownList Style = csDropDownList
Ctl3D = False Ctl3D = False
ItemHeight = 13 ItemHeight = 0
ParentCtl3D = False ParentCtl3D = False
TabOrder = 2 TabOrder = 2
Visible = False Visible = False
@ -639,6 +647,10 @@ inherited frmODDiet: TfrmODDiet
end end
object pgeEarlyLate: TTabSheet object pgeEarlyLate: TTabSheet
Caption = 'Early / Late Tray' Caption = 'Early / Late Tray'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object lblELStart: TLabel object lblELStart: TLabel
Left = 287 Left = 287
Top = 2 Top = 2
@ -871,6 +883,10 @@ inherited frmODDiet: TfrmODDiet
end end
object pgeIsolations: TTabSheet object pgeIsolations: TTabSheet
Caption = 'Isolations / Precautions' Caption = 'Isolations / Precautions'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object lblIsolation: TLabel object lblIsolation: TLabel
Left = 4 Left = 4
Top = 0 Top = 0
@ -931,6 +947,10 @@ inherited frmODDiet: TfrmODDiet
end end
object pgeAdditional: TTabSheet object pgeAdditional: TTabSheet
Caption = 'Additional Order' Caption = 'Additional Order'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object lblAddlOrder: TLabel object lblAddlOrder: TLabel
Left = 4 Left = 4
Top = 24 Top = 24

21
CPRS-Chart/Orders/fODDiet.pas
View File

@ -234,12 +234,21 @@ const
TX_TFQTY = 'A quantity must be entered for '; TX_TFQTY = 'A quantity must be entered for ';
TX_TFAMT = 'The quantity is invalid for '; TX_TFAMT = 'The quantity is invalid for ';
TX_TF5000 = 'The total quantity ordered may not exceed 5000ml.'; TX_TF5000 = 'The total quantity ordered may not exceed 5000ml.';
TX_HLPQTY = CRLF + 'The following may be entered for quantity:' + CRLF +
' Units may be K for Kcals, C for cc''s, M for ml, O for oz. or U for units (e.g. cans).' + CRLF + // CQ #15833 - Removed references of 'c' and 'cc', changed 100CC example to 100ML - JCS
' Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H.' + CRLF + TX_HLPQTY = CRLF + 'Valid entries for quantity:' + CRLF + CRLF +
' May also input 100CC/HR X 16 for 16 hours. Valid quantity for powder form' + CRLF + 'Units K for Kcals; M for ml; O for oz.; U for units (e.g. cans), PKG' + CRLF +
' product can be "# GRAMS" as 20 G, GRAMS, or GMS, or as 1 PKG or 1 U and the' + CRLF + 'Frequency DAILY HOUR QH BID TID QID Q2H Q3H Q4H Q6H' + CRLF + CRLF +
' frequency (e.g. 20 GRAMS/DAY or 1 PKG/TID).'; 'Or 100 ml/HR X 16 for 16 hours' + CRLF + CRLF +
'IF powder form product, Then' + CRLF +
' (# GRAMS or # Unit or PKG) / FREQUENCY' + CRLF + CRLF +
'Examples:' + CRLF +
' 20 GRAMS/Day' + CRLF +
' 1 PKG/TID' + CRLF +
' 6 U/D' + CRLF +
' 1 U/Q3H' + CRLF +
' 50ml/TID' + CRLF +
' 100 ML/HR';
TX_ELMEAL = 'A meal must be selected.'; TX_ELMEAL = 'A meal must be selected.';
TX_ELTIME = 'A meal time must be selected.'; TX_ELTIME = 'A meal time must be selected.';
TX_ELNOSTART = 'A valid start date must be entered.'; TX_ELNOSTART = 'A valid start date must be entered.';

38
CPRS-Chart/Orders/fODGen.dfm
View File

@ -1,12 +1,23 @@
inherited frmODGen: TfrmODGen inherited frmODGen: TfrmODGen
Left = 223 Left = 223
Top = 290 Top = 290
Height = 295
Caption = 'frmODGen' Caption = 'frmODGen'
ExplicitLeft = 223 ExplicitHeight = 295
ExplicitTop = 290
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object sbxMain: TScrollBox [0] object lblOrderSig: TLabel [0]
Left = 8
Top = 193
Width = 44
Height = 13
Caption = 'Order Sig'
end
inherited memOrder: TCaptionMemo
Top = 209
ExplicitTop = 209
end
object sbxMain: TScrollBox [2]
Left = 0 Left = 0
Top = 0 Top = 0
Width = 520 Width = 520
@ -14,9 +25,17 @@ inherited frmODGen: TfrmODGen
Align = alTop Align = alTop
TabOrder = 4 TabOrder = 4
end end
inherited cmdAccept: TButton
Top = 209
ExplicitTop = 209
end
inherited cmdQuit: TButton inherited cmdQuit: TButton
Top = 219 Top = 234
ExplicitTop = 219 ExplicitTop = 234
end
inherited pnlMessage: TPanel
Top = 191
ExplicitTop = 191
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
@ -25,7 +44,8 @@ inherited frmODGen: TfrmODGen
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = memOrder' 'Component = memOrder'
'Status = stsDefault') 'Label = lblOrderSig'
'Status = stsOK')
( (
'Component = cmdAccept' 'Component = cmdAccept'
'Status = stsDefault') 'Status = stsDefault')
@ -42,4 +62,10 @@ inherited frmODGen: TfrmODGen
'Component = frmODGen' 'Component = frmODGen'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object VA508CompMemOrder: TVA508ComponentAccessibility
Component = memOrder
OnStateQuery = VA508CompMemOrderStateQuery
Left = 96
Top = 232
end
end end

113
CPRS-Chart/Orders/fODGen.pas
View File

@ -21,9 +21,12 @@ type
TfrmODGen = class(TfrmODBase) TfrmODGen = class(TfrmODBase)
sbxMain: TScrollBox; sbxMain: TScrollBox;
lblOrderSig: TLabel;
VA508CompMemOrder: TVA508ComponentAccessibility;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure cmdAcceptClick(Sender: TObject); procedure cmdAcceptClick(Sender: TObject);
procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
private private
FilterOut: boolean; FilterOut: boolean;
TsID: string; //treating specialty id TsID: string; //treating specialty id
@ -34,16 +37,17 @@ type
procedure LookupNeedData(Sender: TObject; const StartFrom: string; procedure LookupNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer); Direction, InsertAt: Integer);
procedure PlaceControls; procedure PlaceControls;
procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TrimAllMemos; procedure TrimAllMemos;
function SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl): Boolean;
protected protected
FFormCloseCalled : Boolean; FFormCloseCalled : Boolean;
FCharHt: Integer; FCharHt: Integer;
@ -83,7 +87,7 @@ var
TheEvtType: string; TheEvtType: string;
IDs,TSstr, AttendStr: string; IDs,TSstr, AttendStr: string;
begin begin
FFormCloseCalled := false; FFormCloseCalled := false;
inherited; inherited;
FilterOut := True; FilterOut := True;
if Self.EvtID < 1 then if Self.EvtID < 1 then
@ -242,6 +246,13 @@ begin
if FFirstCtrl <> nil then ActiveControl := FFirstCtrl; if FFirstCtrl <> nil then ActiveControl := FFirstCtrl;
end; end;
procedure TfrmODGen.VA508CompMemOrderStateQuery(Sender: TObject;
var Text: string);
begin
inherited;
Text := memOrder.Text;
end;
procedure TfrmODGen.Validate(var AnErrMsg: string); procedure TfrmODGen.Validate(var AnErrMsg: string);
var var
i: Integer; i: Integer;
@ -327,22 +338,22 @@ begin
DialogCtrl.Required := DialogItem.Required; DialogCtrl.Required := DialogItem.Required;
DialogCtrl.Preserve := Length(DialogItem.EDefault) > 0; DialogCtrl.Preserve := Length(DialogItem.EDefault) > 0;
case DialogItem.DataType of case DialogItem.DataType of
'D': PlaceDateTime(DialogCtrl, DialogItem); 'D': PlaceDateTime(DialogCtrl, DialogItem, I);
'F': PlaceFreeText(DialogCtrl, DialogItem); 'F': PlaceFreeText(DialogCtrl, DialogItem, i);
'H': PlaceHidden(DialogCtrl, DialogItem); 'H': PlaceHidden(DialogCtrl, DialogItem);
'N': PlaceNumeric(DialogCtrl, DialogItem); 'N': PlaceNumeric(DialogCtrl, DialogItem, i);
'P': PlaceLookup(DialogCtrl, DialogItem); 'P': PlaceLookup(DialogCtrl, DialogItem, i);
'R': PlaceDateTime(DialogCtrl, DialogItem); 'R': PlaceDateTime(DialogCtrl, DialogItem, i);
'S': PlaceSetOfCodes(DialogCtrl, DialogItem); 'S': PlaceSetOfCodes(DialogCtrl, DialogItem, i);
'W': PlaceMemo(DialogCtrl, DialogItem); 'W': PlaceMemo(DialogCtrl, DialogItem, i);
'Y': PlaceYesNo(DialogCtrl, DialogItem); 'Y': PlaceYesNo(DialogCtrl, DialogItem, i);
end; end;
FDialogCtrlList.Add(DialogCtrl); FDialogCtrlList.Add(DialogCtrl);
if (DialogCtrl.Editor <> nil) and (FFirstCtrl = nil) then FFirstCtrl := DialogCtrl.Editor; if (DialogCtrl.Editor <> nil) and (FFirstCtrl = nil) then FFirstCtrl := DialogCtrl.Editor;
end; end;
end; end;
procedure TfrmODGen.PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure TfrmODGen.PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const const
NUM_CHAR = 22; NUM_CHAR = 22;
begin begin
@ -353,6 +364,8 @@ begin
Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt); Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
TORDateBox(Editor).DateOnly := Pos('T', DialogItem.Domain) = 0; TORDateBox(Editor).DateOnly := Pos('T', DialogItem.Domain) = 0;
with TORDateBox(Editor) do RequireTime := (not DateOnly) and (Pos('R', DialogItem.Domain) > 0); //v26.48 - RV PSI-05-002 with TORDateBox(Editor) do RequireTime := (not DateOnly) and (Pos('R', DialogItem.Domain) > 0); //v26.48 - RV PSI-05-002
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TORDateBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
TORDateBox(Editor).Text := DialogItem.EDefault; TORDateBox(Editor).Text := DialogItem.EDefault;
TORDateBox(Editor).Hint := DialogItem.HelpText; TORDateBox(Editor).Hint := DialogItem.HelpText;
TORDateBox(Editor).Caption := DialogItem.Prompt; TORDateBox(Editor).Caption := DialogItem.Prompt;
@ -363,7 +376,7 @@ begin
end; end;
end; end;
procedure TfrmODGen.PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure TfrmODGen.PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
begin begin
with DialogCtrl do with DialogCtrl do
begin begin
@ -373,6 +386,8 @@ begin
sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL), sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
HT_FRAME * FCharHt); HT_FRAME * FCharHt);
TEdit(Editor).MaxLength := StrToIntDef(Piece(DialogItem.Domain, ':', 2), 0); TEdit(Editor).MaxLength := StrToIntDef(Piece(DialogItem.Domain, ':', 2), 0);
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
TEdit(Editor).Text := DialogItem.EDefault; TEdit(Editor).Text := DialogItem.EDefault;
TEdit(Editor).Hint := DialogItem.HelpText; TEdit(Editor).Hint := DialogItem.HelpText;
TCaptionEdit(Editor).Caption := DialogItem.Prompt; TCaptionEdit(Editor).Caption := DialogItem.Prompt;
@ -383,7 +398,7 @@ begin
end; end;
end; end;
procedure TfrmODGen.PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure TfrmODGen.PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const const
NUM_CHAR = 16; NUM_CHAR = 16;
begin begin
@ -393,6 +408,8 @@ begin
Editor.Parent := sbxMain; Editor.Parent := sbxMain;
Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt); Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
TEdit(Editor).MaxLength := NUM_CHAR; TEdit(Editor).MaxLength := NUM_CHAR;
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
TEdit(Editor).Text := DialogItem.EDefault; TEdit(Editor).Text := DialogItem.EDefault;
TEdit(Editor).Hint := DialogItem.HelpText + '|' + DialogItem.Domain; TEdit(Editor).Hint := DialogItem.HelpText + '|' + DialogItem.Domain;
TCaptionEdit(Editor).Caption := DialogItem.Prompt; TCaptionEdit(Editor).Caption := DialogItem.Prompt;
@ -403,7 +420,7 @@ begin
end; end;
end; end;
procedure TfrmODGen.PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure TfrmODGen.PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const const
NUM_CHAR = 32; NUM_CHAR = 32;
var var
@ -416,6 +433,8 @@ begin
TORComboBox(Editor).Style := orcsDropDown; TORComboBox(Editor).Style := orcsDropDown;
TORComboBox(Editor).ListItemsOnly := True; TORComboBox(Editor).ListItemsOnly := True;
TORComboBox(Editor).Pieces := '2'; TORComboBox(Editor).Pieces := '2';
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt); Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
x := DialogItem.Domain; x := DialogItem.Domain;
repeat repeat
@ -426,7 +445,7 @@ begin
until Length(x) = 0; until Length(x) = 0;
TORComboBox(Editor).SelectByID(DialogItem.IDefault); TORComboBox(Editor).SelectByID(DialogItem.IDefault);
//TORComboBox(Editor).Text := DialogItem.EDefault; //TORComboBox(Editor).Text := DialogItem.EDefault;
TORComboBox(Editor).Hint := DialogItem.HelpText; TORComboBox(Editor).RpcCall := DialogItem.HelpText;
if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True; if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
TORComboBox(Editor).OnChange := ControlChange; TORComboBox(Editor).OnChange := ControlChange;
PlaceLabel(DialogCtrl, DialogItem); PlaceLabel(DialogCtrl, DialogItem);
@ -434,7 +453,7 @@ begin
end; end;
end; end;
procedure TfrmODGen.PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure TfrmODGen.PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const const
NUM_CHAR = 9; NUM_CHAR = 9;
begin begin
@ -445,12 +464,14 @@ begin
TORComboBox(Editor).Style := orcsDropDown; TORComboBox(Editor).Style := orcsDropDown;
TORComboBox(Editor).ListItemsOnly := True; TORComboBox(Editor).ListItemsOnly := True;
TORComboBox(Editor).Pieces := '2'; TORComboBox(Editor).Pieces := '2';
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
//TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt); Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
TORComboBox(Editor).Items.Add('0^No'); TORComboBox(Editor).Items.Add('0^No');
TORComboBox(Editor).Items.Add('1^Yes'); TORComboBox(Editor).Items.Add('1^Yes');
TORComboBox(Editor).SelectByID(DialogItem.IDefault); TORComboBox(Editor).SelectByID(DialogItem.IDefault);
//TORComboBox(Editor).Text := DialogItem.EDefault; //TORComboBox(Editor).Text := DialogItem.EDefault;
TORComboBox(Editor).Hint := DialogItem.HelpText; TORComboBox(Editor).RpcCall := DialogItem.HelpText;
if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True; if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
TORComboBox(Editor).OnChange := ControlChange; TORComboBox(Editor).OnChange := ControlChange;
PlaceLabel(DialogCtrl, DialogItem); PlaceLabel(DialogCtrl, DialogItem);
@ -458,7 +479,7 @@ begin
end; end;
end; end;
procedure TfrmODGen.PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure TfrmODGen.PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const const
NUM_CHAR = 32; NUM_CHAR = 32;
var var
@ -481,8 +502,10 @@ begin
TORComboBox(Editor).ListItemsOnly := True; TORComboBox(Editor).ListItemsOnly := True;
TORComboBox(Editor).Pieces := '2'; TORComboBox(Editor).Pieces := '2';
TORComboBox(Editor).LongList := True; TORComboBox(Editor).LongList := True;
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
// 2nd bar piece of hint is not visible, hide xref, global ref, & screen code in tab pieces // 2nd bar piece of hint is not visible, hide xref, global ref, & screen code in tab pieces
TORComboBox(Editor).Hint := DialogItem.HelpText + '|' + XRef + #9 + GblRef + #9 + TORComboBox(Editor).RpcCall := DialogItem.HelpText + '|' + XRef + #9 + GblRef + #9 +
DialogItem.ScreenRef; DialogItem.ScreenRef;
if ( compareText(TsID,DialogItem.Id)=0 ) or (compareText(TSDomain,DialogItem.Domain)=0)then if ( compareText(TsID,DialogItem.Id)=0 ) or (compareText(TSDomain,DialogItem.Domain)=0)then
begin begin
@ -537,14 +560,14 @@ var
XRef, GblRef, ScreenRef: string; XRef, GblRef, ScreenRef: string;
begin begin
inherited; inherited;
XRef := Piece(TORComboBox(Sender).Hint, '|', 2); XRef := Piece(TORComboBox(Sender).RpcCall, '|', 2);
GblRef := Piece(XRef, #9, 2); GblRef := Piece(XRef, #9, 2);
ScreenRef := Piece(XRef, #9, 3); ScreenRef := Piece(XRef, #9, 3);
XRef := Piece(XRef, #9, 1); XRef := Piece(XRef, #9, 1);
TORComboBox(Sender).ForDataUse(SubsetOfEntries(StartFrom, Direction, XRef, GblRef, ScreenRef)); TORComboBox(Sender).ForDataUse(SubsetOfEntries(StartFrom, Direction, XRef, GblRef, ScreenRef));
end; end;
procedure TfrmODGen.PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure TfrmODGen.PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const const
NUM_LINES = 3; NUM_LINES = 3;
begin begin
@ -555,6 +578,8 @@ begin
Editor.SetBounds(FEditorLeft, FEditorTop, Editor.SetBounds(FEditorLeft, FEditorTop,
sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL), sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
(FCharHt * NUM_LINES) + HT_FRAME); (FCharHt * NUM_LINES) + HT_FRAME);
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TCaptionMemo(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
TMemo(Editor).Text := DialogItem.EDefault; TMemo(Editor).Text := DialogItem.EDefault;
TMemo(Editor).Hint := DialogItem.HelpText; TMemo(Editor).Hint := DialogItem.HelpText;
TCaptionMemo(Editor).Caption := DialogItem.Prompt; TCaptionMemo(Editor).Caption := DialogItem.Prompt;
@ -573,14 +598,19 @@ begin
end; end;
procedure TfrmODGen.PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); procedure TfrmODGen.PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
var
ht: integer;
begin begin
with DialogCtrl do with DialogCtrl do
begin begin
Prompt := TStaticText.Create(Self); Prompt := TStaticText.Create(Self);
Prompt.Parent := sbxMain; Prompt.Parent := sbxMain;
Prompt.Caption := DialogItem.Prompt; Prompt.Caption := DialogItem.Prompt;
ht := Prompt.Height; // CQ#15849
if ht < FCharHt then
ht := FCharHt;
Prompt.AutoSize := False; Prompt.AutoSize := False;
Prompt.SetBounds(WD_MARGIN, FEditorTop + HT_LBLOFF, FLabelWd, FCharHt); Prompt.SetBounds(WD_MARGIN, FEditorTop + HT_LBLOFF, FLabelWd, ht);
Prompt.Alignment := taRightJustify; Prompt.Alignment := taRightJustify;
Prompt.Visible := True; Prompt.Visible := True;
end; end;
@ -603,8 +633,8 @@ end;
procedure TfrmODGen.cmdAcceptClick(Sender: TObject); procedure TfrmODGen.cmdAcceptClick(Sender: TObject);
begin begin
inherited; inherited;
Application.ProcessMessages;
TrimAllMemos; TrimAllMemos;
Application.ProcessMessages;
end; end;
procedure TfrmODGen.ControlChange(Sender: TObject); procedure TfrmODGen.ControlChange(Sender: TObject);
@ -631,5 +661,30 @@ begin
memOrder.Text := Responses.OrderText; memOrder.Text := Responses.OrderText;
end; end;
function TfrmODGen.SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl): Boolean;
Var
I: Integer;
SaveName: String;
begin
//strip all non alphanumeric characters to create the save name
SaveName := '';
//Check for blank id
if DialogCtrl.ID = '' then DialogCtrl.ID := 'EMPTY';
for i := 1 to length(DialogCtrl.ID) do begin
if (DialogCtrl.ID[i] in ['A'..'Z']) or (DialogCtrl.ID[i] in ['a'..'z']) or (DialogCtrl.ID[i] in ['0'..'9']) then
SaveName := SaveName + DialogCtrl.ID[i];
end;
SaveName := SaveName + '_' + IntToStr(Index);
//extra backup - make sure that the component name doesn't already exist
//Now set up the component name
try
Editor.Name := SaveName;
except
Editor.Name := SaveName + '_' + IntToStr(Index);
end;
end;
end. end.

182
CPRS-Chart/Orders/fODLab.dfm
View File

@ -98,7 +98,7 @@ inherited frmODLab: TfrmODLab
Caption = 'Collection Type' Caption = 'Collection Type'
end end
inherited memOrder: TCaptionMemo inherited memOrder: TCaptionMemo
TabOrder = 20 TabOrder = 22
end end
object txtImmedColl: TCaptionEdit [13] object txtImmedColl: TCaptionEdit [13]
Left = 149 Left = 149
@ -107,7 +107,7 @@ inherited frmODLab: TfrmODLab
Height = 21 Height = 21
Color = clBtnFace Color = clBtnFace
ReadOnly = True ReadOnly = True
TabOrder = 14 TabOrder = 16
Text = 'txtImmedColl' Text = 'txtImmedColl'
end end
object calCollTime: TORDateBox [14] object calCollTime: TORDateBox [14]
@ -115,7 +115,7 @@ inherited frmODLab: TfrmODLab
Top = 166 Top = 166
Width = 165 Width = 165
Height = 21 Height = 21
TabOrder = 13 TabOrder = 15
OnChange = ControlChange OnChange = ControlChange
DateOnly = False DateOnly = False
RequireTime = False RequireTime = False
@ -127,7 +127,7 @@ inherited frmODLab: TfrmODLab
Height = 118 Height = 118
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 8 TabOrder = 10
object lblUrineVolume: TOROffsetLabel object lblUrineVolume: TOROffsetLabel
Left = 6 Left = 6
Top = 29 Top = 29
@ -155,7 +155,7 @@ inherited frmODLab: TfrmODLab
Height = 118 Height = 118
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 7 TabOrder = 9
object lblAntiCoagulant: TOROffsetLabel object lblAntiCoagulant: TOROffsetLabel
Left = 6 Left = 6
Top = 8 Top = 8
@ -183,7 +183,7 @@ inherited frmODLab: TfrmODLab
Height = 118 Height = 118
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 6 TabOrder = 8
Visible = False Visible = False
object lblOrderComment: TOROffsetLabel object lblOrderComment: TOROffsetLabel
Left = 6 Left = 6
@ -211,7 +211,7 @@ inherited frmODLab: TfrmODLab
Width = 133 Width = 133
Height = 118 Height = 118
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 5 TabOrder = 7
end end
object pnlDoseDraw: TORAutoPanel [19] object pnlDoseDraw: TORAutoPanel [19]
Left = 378 Left = 378
@ -220,7 +220,7 @@ inherited frmODLab: TfrmODLab
Height = 118 Height = 118
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 10 TabOrder = 12
object lblDose: TOROffsetLabel object lblDose: TOROffsetLabel
Left = 10 Left = 10
Top = 15 Top = 15
@ -267,7 +267,7 @@ inherited frmODLab: TfrmODLab
Height = 118 Height = 118
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 9 TabOrder = 11
object lblPeakTrough: TOROffsetLabel object lblPeakTrough: TOROffsetLabel
Left = 6 Left = 6
Top = 7 Top = 7
@ -293,44 +293,14 @@ inherited frmODLab: TfrmODLab
OnClick = grpPeakTroughClick OnClick = grpPeakTroughClick
end end
end end
inherited cmdAccept: TButton object pnlCollTimeButton: TKeyClickPanel [21]
Left = 443
TabOrder = 18
ExplicitLeft = 443
end
inherited cmdQuit: TButton
TabOrder = 19
end
inherited pnlMessage: TPanel
Left = 18
Top = 192
Height = 56
TabOrder = 21
ExplicitLeft = 18
ExplicitTop = 192
ExplicitHeight = 56
inherited imgMessage: TImage
Top = 11
ExplicitTop = 11
end
inherited memMessage: TRichEdit
Left = 41
Top = 5
Height = 43
PopupMenu = MessagePopup
ExplicitLeft = 41
ExplicitTop = 5
ExplicitHeight = 43
end
end
object pnlCollTimeButton: TKeyClickPanel [24]
Left = 288 Left = 288
Top = 167 Top = 167
Width = 20 Width = 20
Height = 19 Height = 19
BevelOuter = bvNone BevelOuter = bvNone
Caption = 'Select collection time' Caption = 'Select collection time'
TabOrder = 15 TabOrder = 17
TabStop = True TabStop = True
OnClick = cmdImmedCollClick OnClick = cmdImmedCollClick
OnEnter = pnlCollTimeButtonEnter OnEnter = pnlCollTimeButtonEnter
@ -359,7 +329,7 @@ inherited frmODLab: TfrmODLab
OnClick = cmdImmedCollClick OnClick = cmdImmedCollClick
end end
end end
object cboAvailTest: TORComboBox [25] object cboAvailTest: TORComboBox [22]
Left = 6 Left = 6
Top = 18 Top = 18
Width = 168 Width = 168
@ -385,7 +355,7 @@ inherited frmODLab: TfrmODLab
OnNeedData = cboAvailTestNeedData OnNeedData = cboAvailTestNeedData
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboFrequency: TORComboBox [26] object cboFrequency: TORComboBox [23]
Left = 326 Left = 326
Top = 166 Top = 166
Width = 97 Width = 97
@ -405,11 +375,11 @@ inherited frmODLab: TfrmODLab
Pieces = '2' Pieces = '2'
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 16 TabOrder = 18
OnChange = cboFrequencyChange OnChange = cboFrequencyChange
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboCollSamp: TORComboBox [27] object cboCollSamp: TORComboBox [24]
Left = 269 Left = 269
Top = 28 Top = 28
Width = 100 Width = 100
@ -436,7 +406,7 @@ inherited frmODLab: TfrmODLab
OnMouseClick = cboCollSampMouseClick OnMouseClick = cboCollSampMouseClick
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboSpecimen: TORComboBox [28] object cboSpecimen: TORComboBox [25]
Left = 269 Left = 269
Top = 55 Top = 55
Width = 100 Width = 100
@ -458,14 +428,14 @@ inherited frmODLab: TfrmODLab
ShowHint = True ShowHint = True
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 2 TabOrder = 3
OnChange = cboSpecimenChange OnChange = cboSpecimenChange
OnEnter = cboSpecimenMouseClick OnEnter = cboSpecimenMouseClick
OnKeyPause = cboSpecimenKeyPause OnKeyPause = cboSpecimenKeyPause
OnMouseClick = cboSpecimenMouseClick OnMouseClick = cboSpecimenMouseClick
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboUrgency: TORComboBox [29] object cboUrgency: TORComboBox [26]
Left = 269 Left = 269
Top = 82 Top = 82
Width = 100 Width = 100
@ -485,32 +455,32 @@ inherited frmODLab: TfrmODLab
Pieces = '2' Pieces = '2'
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 3 TabOrder = 5
OnChange = cboUrgencyChange OnChange = cboUrgencyChange
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object txtAddlComment: TCaptionEdit [30] object txtAddlComment: TCaptionEdit [27]
Left = 187 Left = 187
Top = 122 Top = 122
Width = 180 Width = 180
Height = 21 Height = 21
TabOrder = 4 TabOrder = 6
Visible = False Visible = False
OnExit = txtAddlCommentExit OnExit = txtAddlCommentExit
Caption = 'Additional Comment' Caption = 'Additional Comment'
end end
object txtDays: TCaptionEdit [31] object txtDays: TCaptionEdit [28]
Left = 430 Left = 430
Top = 166 Top = 166
Width = 84 Width = 84
Height = 21 Height = 21
Hint = 'Enter a number of days, or an "X" followed by a number of times.' Hint = 'Enter a number of days, or an "X" followed by a number of times.'
Enabled = False Enabled = False
TabOrder = 17 TabOrder = 20
OnChange = ControlChange OnChange = ControlChange
Caption = 'How Long?' Caption = 'How Long?'
end end
object FLabCommonCombo: TORListBox [32] object FLabCommonCombo: TORListBox [29]
Left = 440 Left = 440
Top = 247 Top = 247
Width = 121 Width = 121
@ -519,12 +489,12 @@ inherited frmODLab: TfrmODLab
ItemHeight = 13 ItemHeight = 13
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 22 TabOrder = 26
Visible = False Visible = False
ItemTipColor = clWindow ItemTipColor = clWindow
LongList = False LongList = False
end end
object cboCollTime: TORComboBox [33] object cboCollTime: TORComboBox [30]
Left = 149 Left = 149
Top = 166 Top = 166
Width = 168 Width = 168
@ -544,12 +514,12 @@ inherited frmODLab: TfrmODLab
Pieces = '2' Pieces = '2'
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 12 TabOrder = 14
OnChange = cboCollTimeChange OnChange = cboCollTimeChange
OnExit = cboCollTimeExit OnExit = cboCollTimeExit
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboCollType: TORComboBox [34] object cboCollType: TORComboBox [31]
Left = 6 Left = 6
Top = 166 Top = 166
Width = 136 Width = 136
@ -569,10 +539,92 @@ inherited frmODLab: TfrmODLab
Pieces = '2' Pieces = '2'
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 11 TabOrder = 13
OnChange = cboCollTypeChange OnChange = cboCollTypeChange
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object Frequencylbl508: TVA508StaticText [32]
Name = 'Frequencylbl508'
Left = 323
Top = 149
Width = 59
Height = 15
Alignment = taLeftJustify
Caption = 'How Often?'
Enabled = False
TabOrder = 19
Visible = False
ShowAccelChar = True
end
object HowManyDayslbl508: TVA508StaticText [33]
Name = 'HowManyDayslbl508'
Left = 431
Top = 152
Width = 57
Height = 15
Alignment = taLeftJustify
Caption = 'How Long?'
Enabled = False
TabOrder = 21
Visible = False
ShowAccelChar = True
end
inherited cmdAccept: TButton
Left = 443
TabOrder = 23
ExplicitLeft = 443
end
object specimenlbl508: TVA508StaticText [35]
Name = 'specimenlbl508'
Left = 210
Top = 56
Width = 49
Height = 15
Alignment = taLeftJustify
Caption = 'Specimen'
Enabled = False
TabOrder = 4
Visible = False
ShowAccelChar = True
end
inherited cmdQuit: TButton
TabOrder = 24
end
object CollSamplbl508: TVA508StaticText [37]
Name = 'CollSamplbl508'
Left = 187
Top = 31
Width = 72
Height = 15
Alignment = taLeftJustify
Caption = 'Collect Sample'
Enabled = False
TabOrder = 2
Visible = False
ShowAccelChar = True
end
inherited pnlMessage: TPanel
Left = 18
Top = 192
Height = 56
TabOrder = 25
ExplicitLeft = 18
ExplicitTop = 192
ExplicitHeight = 56
inherited imgMessage: TImage
Top = 11
ExplicitTop = 11
end
inherited memMessage: TRichEdit
Left = 41
Top = 5
Height = 43
PopupMenu = MessagePopup
ExplicitLeft = 41
ExplicitTop = 5
ExplicitHeight = 43
end
end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
( (
@ -667,6 +719,18 @@ inherited frmODLab: TfrmODLab
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = frmODLab' 'Component = frmODLab'
'Status = stsDefault')
(
'Component = Frequencylbl508'
'Status = stsDefault')
(
'Component = HowManyDayslbl508'
'Status = stsDefault')
(
'Component = specimenlbl508'
'Status = stsDefault')
(
'Component = CollSamplbl508'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object dlgLabCollTime: TORDateTimeDlg object dlgLabCollTime: TORDateTimeDlg

64
CPRS-Chart/Orders/fODLab.pas
View File

@ -5,7 +5,7 @@ interface
uses uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst, Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
ORDtTm, Buttons, Menus, VA508AccessibilityManager; ORDtTm, Buttons, Menus, VA508AccessibilityManager, VA508AccessibilityRouter;
type type
TfrmODLab = class(TfrmODBase) TfrmODLab = class(TfrmODBase)
@ -56,6 +56,10 @@ type
cmdImmedColl: TSpeedButton; cmdImmedColl: TSpeedButton;
MessagePopup: TPopupMenu; MessagePopup: TPopupMenu;
ViewinReportWindow1: TMenuItem; ViewinReportWindow1: TMenuItem;
Frequencylbl508: TVA508StaticText;
HowManyDayslbl508: TVA508StaticText;
specimenlbl508: TVA508StaticText;
CollSamplbl508: TVA508StaticText;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure ControlChange(Sender: TObject); procedure ControlChange(Sender: TObject);
procedure cboAvailTestNeedData(Sender: TObject; procedure cboAvailTestNeedData(Sender: TObject;
@ -106,6 +110,7 @@ type
FEvtDivision: integer; FEvtDivision: integer;
procedure ReadServerVariables; procedure ReadServerVariables;
procedure DisplayChangedOrders(ACollType: string); procedure DisplayChangedOrders(ACollType: string);
procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl; lbl2: string);
public public
procedure SetupDialog(OrderAction: Integer; const ID: string); override; procedure SetupDialog(OrderAction: Integer; const ID: string); override;
procedure LoadRequiredComment(CmtType: integer); procedure LoadRequiredComment(CmtType: integer);
@ -205,7 +210,7 @@ const
procedure TfrmODLab.FormCreate(Sender: TObject); procedure TfrmODLab.FormCreate(Sender: TObject);
var var
i, n: integer; i, n, HMD508: integer;
AList: TStringList; AList: TStringList;
begin begin
frmFrame.pnlVisit.Enabled := false; frmFrame.pnlVisit.Enabled := false;
@ -262,7 +267,10 @@ begin
SetControl(cboAvailTest, 'ShortList'); SetControl(cboAvailTest, 'ShortList');
if cboAvailTest.Items.Count > 0 then cboAvailTest.InsertSeparator; if cboAvailTest.Items.Count > 0 then cboAvailTest.InsertSeparator;
cboAvailTest.InitLongList(''); cboAvailTest.InitLongList('');
//TDP - CQ#19396 HMD508 added to guarantee 508 label did not change width
HMD508 := HowManyDayslbl508.Width;
SetControl(cboFrequency, 'Schedules'); SetControl(cboFrequency, 'Schedules');
HowManydayslbl508.Width := HMD508;
with cboFrequency do with cboFrequency do
begin begin
if ItemIndex < 0 then ItemIndex := Items.IndexOf('ONE TIME'); if ItemIndex < 0 then ItemIndex := Items.IndexOf('ONE TIME');
@ -270,6 +278,8 @@ begin
end; end;
lblHowManyDays.Enabled := False; { have this call change event in case } lblHowManyDays.Enabled := False; { have this call change event in case }
txtDays.Enabled := False; { the default is not 'one time'? } txtDays.Enabled := False; { the default is not 'one time'? }
//TDP - CQ#19396 Following line does not appear to be needed
//setup508Label(HowManyText, HowManyDayslbl508, txtDays, lblHowManyDays.Caption);
end; end;
if EvTDelayLoc>0 then if EvTDelayLoc>0 then
n := MaxDays(EvtDelayLoc, 0) n := MaxDays(EvtDelayLoc, 0)
@ -282,6 +292,7 @@ begin
Enabled := False; Enabled := False;
Font.Color := clGrayText; Font.Color := clGrayText;
lblFrequency.Enabled := False; lblFrequency.Enabled := False;
setup508Label(Text, Frequencylbl508, cboFrequency, lblFrequency.Caption);
end; end;
PreserveControl(cboAvailTest); PreserveControl(cboAvailTest);
PreserveControl(cboCollType); PreserveControl(cboCollType);
@ -295,6 +306,22 @@ begin
end; end;
end; end;
{TDP - CQ#19396 Added to address 508 related changes. I modified slightly to
change lbl.Caption and retain lbl.Width}
procedure TfrmODLab.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl; lbl2: string);
var
Width: integer;
begin
if ScreenReaderSystemActive and not ctrl.Enabled then begin
lbl.Enabled := True;
lbl.Visible := True;
Width := lbl.Width;
lbl.Caption := lbl2 +'. Read Only. Value is ' + Text;
lbl.Width := Width;
end else
lbl.Visible := false;
end;
procedure TfrmODLab.InitDialog; procedure TfrmODLab.InitDialog;
begin begin
inherited; inherited;
@ -744,18 +771,28 @@ end;
procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox); procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
var var
i: integer; i, PreviousSelectionIndex: integer;
PreviousSelectionString: String;
begin begin
with AComboBox do with AComboBox do
begin begin
PreviousSelectionIndex := -1;
PreviousSelectionString := SelText;
Clear; Clear;
for i := 0 to UrgencyList.Count - 1 do for i := 0 to UrgencyList.Count - 1 do begin
if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
Continue Continue
else else
Items.Add(UrgencyList[i]); Items.Add(UrgencyList[i]);
if (PreviousSelectionString <> '') and (PreviousSelectionString = Piece(UrgencyList[i], U, 2)) then
PreviousSelectionIndex := i;
end;
if (LRFURG <> '') and (ALabTest.ObtainUrgency) then if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
SelectByID(LRFURG) SelectByID(LRFURG)
else if PreviousSelectionIndex > -1 then
ItemIndex := PreviousSelectionIndex
else else
SelectByIEN(uDfltUrgency); SelectByIEN(uDfltUrgency);
Urgency := AComboBox.ItemIEN; Urgency := AComboBox.ItemIEN;
@ -1291,6 +1328,8 @@ begin
begin begin
lblCollSamp.Enabled := True; lblCollSamp.Enabled := True;
cboCollSamp.Enabled := True; cboCollSamp.Enabled := True;
//TDP - CQ#19396 Added cboCollSamp 508 changes
setup508Label(cboCollSamp.Text, collsamplbl508, cboCollSamp, lblCollSamp.Caption);
end end
else else
begin begin
@ -1305,15 +1344,19 @@ begin
end ; end ;
lblCollSamp.Enabled := False; lblCollSamp.Enabled := False;
cboCollSamp.Enabled := False; cboCollSamp.Enabled := False;
//TDP - CQ#19396 Added cboCollSamp 508 changes
setup508Label(cboCollSamp.Text, collsamplbl508, cboCollSamp, lblCollSamp.Caption);
end; end;
if ObtainSpecimen then if ObtainSpecimen then
begin begin
lblSpecimen.Enabled:= True; lblSpecimen.Enabled:= True;
cboSpecimen.Enabled:= True; cboSpecimen.Enabled:= True;
setup508Label(cboSpecimen.Text, specimenlbl508, cboSpecimen, lblSpecimen.Caption);
end else end else
begin begin
lblSpecimen.Enabled:= False; lblSpecimen.Enabled:= False;
cboSpecimen.Enabled:= False; cboSpecimen.Enabled:= False;
setup508Label(cboSpecimen.Text, specimenlbl508, cboSpecimen, lblSpecimen.Caption);
end; end;
if ObtainUrgency then if ObtainUrgency then
begin begin
@ -1359,10 +1402,12 @@ begin
begin begin
lblSpecimen.Enabled:= True; lblSpecimen.Enabled:= True;
cboSpecimen.Enabled:= True; cboSpecimen.Enabled:= True;
setup508Label(cboSpecimen.Text, specimenlbl508, cboSpecimen, lblSpecimen.Caption);
end else end else
begin begin
lblSpecimen.Enabled:= False; lblSpecimen.Enabled:= False;
cboSpecimen.Enabled:= False; cboSpecimen.Enabled:= False;
setup508Label(cboSpecimen.Text, specimenlbl508, cboSpecimen, lblSpecimen.Caption);
end; end;
if ObtainComment then if ObtainComment then
LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment)) LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
@ -1418,7 +1463,7 @@ end;
procedure TfrmODLab.cboFrequencyChange(Sender: TObject); procedure TfrmODLab.cboFrequencyChange(Sender: TObject);
var var
x: string; x, HowManyText: string;
const const
HINT_TEXT1 = 'Enter a number of days'; HINT_TEXT1 = 'Enter a number of days';
HINT_TEXT2 = ', or an "X" followed by a number of times.'; HINT_TEXT2 = ', or an "X" followed by a number of times.';
@ -1433,6 +1478,10 @@ begin
else else
txtDays.Hint := ''; txtDays.Hint := '';
txtDays.Enabled := True; txtDays.Enabled := True;
//TDP - txtDays 508 changes
if txtDays.Text = '' then HowManyText := 'no value'
else HowManyText := txtDays.Text;
setup508Label(HowManyText, HowManyDayslbl508, txtDays, lblHowManyDays.Caption);
txtDays.Showhint := True; txtDays.Showhint := True;
end end
else else
@ -1440,6 +1489,9 @@ begin
txtDays.Text := ''; txtDays.Text := '';
lblHowManyDays.Enabled := False; lblHowManyDays.Enabled := False;
txtDays.Enabled := False; txtDays.Enabled := False;
//TDP - txtDays 508 changes
HowManyText := 'no value';
setup508Label(HowManyText, HowManyDayslbl508, txtDays, lblHowManyDays.Caption);
txtDays.ShowHint := False; txtDays.ShowHint := False;
end; end;
ControlChange(Self); ControlChange(Self);
@ -2024,5 +2076,3 @@ begin
end; end;
end. end.

232
CPRS-Chart/Orders/fODMedIV.dfm
View File

@ -4,7 +4,7 @@ inherited frmODMedIV: TfrmODMedIV
Width = 668 Width = 668
Height = 465 Height = 465
Caption = 'Infusion Order' Caption = 'Infusion Order'
Constraints.MinHeight = 350 Constraints.MinHeight = 360
Constraints.MinWidth = 500 Constraints.MinWidth = 500
ExplicitWidth = 668 ExplicitWidth = 668
ExplicitHeight = 465 ExplicitHeight = 465
@ -26,14 +26,14 @@ inherited frmODMedIV: TfrmODMedIV
end end
object lblComponent: TLabel [2] object lblComponent: TLabel [2]
Left = 214 Left = 214
Top = 7 Top = 6
Width = 85 Width = 85
Height = 13 Height = 13
Caption = 'Solution/Additive*' Caption = 'Solution/Additive*'
end end
object lblAmount: TLabel [3] object lblAmount: TLabel [3]
Left = 328 Left = 328
Top = 7 Top = 6
Width = 84 Width = 84
Height = 13 Height = 13
Caption = 'Volume/Strength*' Caption = 'Volume/Strength*'
@ -54,11 +54,11 @@ inherited frmODMedIV: TfrmODMedIV
Caption = 'Duration or Total Volume (Optional)' Caption = 'Duration or Total Volume (Optional)'
end end
object Label1: TLabel [6] object Label1: TLabel [6]
Left = 8 Left = 10
Top = 344 Top = 345
Width = 133 Width = 44
Height = 13 Height = 13
Caption = ' * Indicates a Required Field' Caption = 'Order Sig'
end end
object lblRoute: TLabel [7] object lblRoute: TLabel [7]
Left = 8 Left = 8
@ -130,17 +130,31 @@ inherited frmODMedIV: TfrmODMedIV
ShowHint = False ShowHint = False
OnClick = lblTypeHelpClick OnClick = lblTypeHelpClick
end end
object txtRate: TCaptionEdit [13] object lblAddFreq: TLabel [13]
Left = 488
Top = 6
Width = 95
Height = 13
Caption = 'Additive Frequency*'
end
object lblPrevAddFreq: TLabel [14]
Left = 557
Top = 6
Width = 77
Height = 13
Caption = 'Prev. Add. Freq.'
end
object txtRate: TCaptionEdit [15]
Left = 486 Left = 486
Top = 211 Top = 211
Width = 91 Width = 91
Height = 21 Height = 21
AutoSelect = False AutoSelect = False
TabOrder = 8 TabOrder = 10
OnChange = txtRateChange OnChange = txtRateChange
Caption = 'Infusion Rate' Caption = 'Infusion Rate'
end end
object cboPriority: TORComboBox [14] object cboPriority: TORComboBox [16]
Left = 8 Left = 8
Top = 252 Top = 252
Width = 72 Width = 72
@ -160,40 +174,40 @@ inherited frmODMedIV: TfrmODMedIV
Pieces = '2' Pieces = '2'
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 10 TabOrder = 12
OnChange = cboPriorityChange OnChange = cboPriorityChange
OnExit = cboPriorityExit OnExit = cboPriorityExit
OnKeyUp = cboPriorityKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object grdSelected: TCaptionStringGrid [15] object grdSelected: TCaptionStringGrid [17]
Left = 214 Left = 215
Top = 21 Top = 18
Width = 437 Width = 437
Height = 76 Height = 76
ColCount = 3
DefaultColWidth = 100 DefaultColWidth = 100
DefaultRowHeight = 19 DefaultRowHeight = 19
DefaultDrawing = False
FixedCols = 0 FixedCols = 0
RowCount = 1 RowCount = 1
FixedRows = 0 FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected] Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected]
ScrollBars = ssVertical ScrollBars = ssVertical
TabOrder = 1 TabOrder = 2
OnDrawCell = grdSelectedDrawCell OnDrawCell = grdSelectedDrawCell
OnKeyPress = grdSelectedKeyPress OnKeyPress = grdSelectedKeyPress
OnMouseDown = grdSelectedMouseDown OnMouseDown = grdSelectedMouseDown
Caption = 'Selected Solution and Additives'
end end
object cmdRemove: TButton [16] object cmdRemove: TButton [18]
Left = 443 Left = 443
Top = 100 Top = 100
Width = 72 Width = 72
Height = 18 Height = 18
Caption = 'Remove' Caption = 'Remove'
TabOrder = 2 TabOrder = 3
OnClick = cmdRemoveClick OnClick = cmdRemoveClick
end end
object memComments: TCaptionMemo [17] object memComments: TCaptionMemo [19]
Left = 214 Left = 214
Top = 121 Top = 121
Width = 437 Width = 437
@ -201,11 +215,11 @@ inherited frmODMedIV: TfrmODMedIV
Lines.Strings = ( Lines.Strings = (
'memComments') 'memComments')
ScrollBars = ssVertical ScrollBars = ssVertical
TabOrder = 13 TabOrder = 4
OnChange = ControlChange OnChange = ControlChange
Caption = 'Comments' Caption = 'Comments'
end end
object txtSelected: TCaptionEdit [18] object txtSelected: TCaptionEdit [20]
Tag = -1 Tag = -1
Left = 416 Left = 416
Top = 45 Top = 45
@ -218,11 +232,12 @@ inherited frmODMedIV: TfrmODMedIV
Visible = False Visible = False
OnChange = txtSelectedChange OnChange = txtSelectedChange
OnExit = txtSelectedExit OnExit = txtSelectedExit
OnKeyDown = txtSelectedKeyDown
Caption = 'Volume' Caption = 'Volume'
end end
object cboSelected: TCaptionComboBox [19] object cboSelected: TCaptionComboBox [21]
Tag = -1 Tag = -1
Left = 460 Left = 462
Top = 45 Top = 45
Width = 53 Width = 53
Height = 21 Height = 21
@ -230,27 +245,26 @@ inherited frmODMedIV: TfrmODMedIV
Ctl3D = False Ctl3D = False
ItemHeight = 13 ItemHeight = 13
ParentCtl3D = False ParentCtl3D = False
TabOrder = 4 TabOrder = 6
Visible = False Visible = False
OnChange = cboSelectedChange OnCloseUp = cboSelectedCloseUp
OnExit = cboSelectedExit OnKeyDown = cboSelectedKeyDown
Caption = 'Volume/Strength' Caption = 'Volume/Strength'
end end
inherited memOrder: TCaptionMemo inherited memOrder: TCaptionMemo
Top = 359 Top = 364
Width = 475 Width = 475
TabStop = True TabOrder = 17
TabOrder = 16 ExplicitTop = 364
ExplicitTop = 359
ExplicitWidth = 475 ExplicitWidth = 475
end end
object pnlXDuration: TPanel [21] object pnlXDuration: TPanel [23]
Left = 184 Left = 184
Top = 252 Top = 252
Width = 150 Width = 150
Height = 21 Height = 21
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 11 TabOrder = 13
OnEnter = pnlXDurationEnter OnEnter = pnlXDurationEnter
object txtXDuration: TCaptionEdit object txtXDuration: TCaptionEdit
Left = 0 Left = 0
@ -260,7 +274,6 @@ inherited frmODMedIV: TfrmODMedIV
TabOrder = 0 TabOrder = 0
OnChange = txtXDurationChange OnChange = txtXDurationChange
OnExit = txtXDurationExit OnExit = txtXDurationExit
Caption = 'Duration'
end end
object cboDuration: TComboBox object cboDuration: TComboBox
Left = 70 Left = 70
@ -268,18 +281,18 @@ inherited frmODMedIV: TfrmODMedIV
Width = 75 Width = 75
Height = 21 Height = 21
ItemHeight = 13 ItemHeight = 13
TabOrder = 2 TabOrder = 1
OnChange = cboDurationChange OnChange = cboDurationChange
OnEnter = cboDurationEnter OnEnter = cboDurationEnter
end end
end end
object pnlCombo: TPanel [22] object pnlCombo: TPanel [24]
Left = 8 Left = 8
Top = 2 Top = 2
Width = 200 Width = 200
Height = 185 Height = 185
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 25 TabOrder = 26
object cboAdditive: TORComboBox object cboAdditive: TORComboBox
Left = 0 Left = 0
Top = 20 Top = 20
@ -302,7 +315,7 @@ inherited frmODMedIV: TfrmODMedIV
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabPositions = '20' TabPositions = '20'
TabOrder = 0 TabOrder = 1
OnExit = cboAdditiveExit OnExit = cboAdditiveExit
OnMouseClick = cboAdditiveMouseClick OnMouseClick = cboAdditiveMouseClick
OnNeedData = cboAdditiveNeedData OnNeedData = cboAdditiveNeedData
@ -320,7 +333,6 @@ inherited frmODMedIV: TfrmODMedIV
' Solutions ' ' Solutions '
' Additives ') ' Additives ')
TabIndex = 0 TabIndex = 0
TabStop = False
OnChange = tabFluidChange OnChange = tabFluidChange
end end
object cboSolution: TORComboBox object cboSolution: TORComboBox
@ -345,14 +357,14 @@ inherited frmODMedIV: TfrmODMedIV
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabPositions = '20' TabPositions = '20'
TabOrder = 1 TabOrder = 0
OnExit = cboSolutionExit OnExit = cboSolutionExit
OnMouseClick = cboSolutionMouseClick OnMouseClick = cboSolutionMouseClick
OnNeedData = cboSolutionNeedData OnNeedData = cboSolutionNeedData
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
end end
object cboRoute: TORComboBox [23] object cboRoute: TORComboBox [25]
Left = 8 Left = 8
Top = 211 Top = 211
Width = 168 Width = 168
@ -371,14 +383,16 @@ inherited frmODMedIV: TfrmODMedIV
Pieces = '2' Pieces = '2'
Sorted = False Sorted = False
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 3 TabOrder = 5
OnChange = cboRouteChange OnChange = cboRouteChange
OnClick = cboRouteClick OnClick = cboRouteClick
OnExit = cboRouteExit OnExit = cboRouteExit
OnKeyDown = cboRouteKeyDown
OnKeyUp = cboRouteKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
UniqueAutoComplete = True UniqueAutoComplete = True
end end
object cboSchedule: TORComboBox [24] object cboSchedule: TORComboBox [26]
Left = 304 Left = 304
Top = 211 Top = 211
Width = 129 Width = 129
@ -397,14 +411,16 @@ inherited frmODMedIV: TfrmODMedIV
Pieces = '1' Pieces = '1'
Sorted = True Sorted = True
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 6 TabOrder = 8
OnChange = cboScheduleChange OnChange = cboScheduleChange
OnClick = cboScheduleClick OnClick = cboScheduleClick
OnExit = cboScheduleExit OnExit = cboScheduleExit
OnKeyDown = cboScheduleKeyDown
OnKeyUp = cboScheduleKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
UniqueAutoComplete = True UniqueAutoComplete = True
end end
object cboType: TComboBox [25] object cboType: TComboBox [27]
Left = 184 Left = 184
Top = 211 Top = 211
Width = 114 Width = 114
@ -412,19 +428,20 @@ inherited frmODMedIV: TfrmODMedIV
ItemHeight = 13 ItemHeight = 13
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 5 TabOrder = 7
OnChange = cboTypeChange OnChange = cboTypeChange
OnKeyDown = cboTypeKeyDown
end end
object chkPRN: TCheckBox [26] object chkPRN: TCheckBox [28]
Left = 436 Left = 436
Top = 213 Top = 213
Width = 45 Width = 45
Height = 21 Height = 21
Caption = 'PRN' Caption = 'PRN'
TabOrder = 7 TabOrder = 9
OnClick = chkPRNClick OnClick = chkPRNClick
end end
object chkDoseNow: TCheckBox [27] object chkDoseNow: TCheckBox [29]
Left = 8 Left = 8
Top = 279 Top = 279
Width = 147 Width = 147
@ -432,20 +449,20 @@ inherited frmODMedIV: TfrmODMedIV
Anchors = [akLeft] Anchors = [akLeft]
Caption = 'Give Additional Dose Now' Caption = 'Give Additional Dose Now'
Constraints.MinWidth = 147 Constraints.MinWidth = 147
TabOrder = 12 TabOrder = 14
OnClick = chkDoseNowClick OnClick = chkDoseNowClick
end end
object cboInfusionTime: TComboBox [28] object cboInfusionTime: TComboBox [30]
Left = 576 Left = 576
Top = 211 Top = 211
Width = 74 Width = 74
Height = 21 Height = 21
ItemHeight = 13 ItemHeight = 13
TabOrder = 9 TabOrder = 11
OnChange = cboInfusionTimeChange OnChange = cboInfusionTimeChange
OnEnter = cboInfusionTimeEnter OnEnter = cboInfusionTimeEnter
end end
object lblAdminTime: TVA508StaticText [29] object lblAdminTime: TVA508StaticText [31]
Name = 'lblAdminTime' Name = 'lblAdminTime'
Left = 8 Left = 8
Top = 308 Top = 308
@ -454,52 +471,76 @@ inherited frmODMedIV: TfrmODMedIV
Alignment = taLeftJustify Alignment = taLeftJustify
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 14 TabOrder = 15
TabStop = True TabStop = True
Visible = False Visible = False
ShowAccelChar = True ShowAccelChar = True
end end
object lblFirstDose: TVA508StaticText [30] object lblFirstDose: TVA508StaticText [32]
Name = 'lblFirstDose' Name = 'lblFirstDose'
Left = 8 Left = 8
Top = 323 Top = 323
Width = 4 Width = 4
Height = 4 Height = 4
Alignment = taLeftJustify Alignment = taLeftJustify
TabOrder = 15 TabOrder = 16
TabStop = True TabStop = True
Visible = False Visible = False
ShowAccelChar = True ShowAccelChar = True
end end
object cboAddFreq: TCaptionComboBox [33]
Left = 488
Top = 72
Width = 145
Height = 21
ItemHeight = 13
TabOrder = 25
Visible = False
OnCloseUp = cboAddFreqCloseUp
OnKeyDown = cboAddFreqKeyDown
end
inherited cmdAccept: TButton inherited cmdAccept: TButton
Left = 495 Left = 495
Top = 359 Top = 364
TabOrder = 17 TabOrder = 18
ExplicitLeft = 495 ExplicitLeft = 495
ExplicitTop = 359 ExplicitTop = 364
end end
inherited cmdQuit: TButton inherited cmdQuit: TButton
Left = 495 Left = 495
Top = 386 Top = 391
TabOrder = 18 TabOrder = 19
ExplicitLeft = 495 ExplicitLeft = 495
ExplicitTop = 386 ExplicitTop = 391
end end
inherited pnlMessage: TPanel inherited pnlMessage: TPanel
Left = 56 Left = 56
Top = 349 Top = 341
TabOrder = 19 TabOrder = 20
ExplicitLeft = 56 ExplicitLeft = 56
ExplicitTop = 349 ExplicitTop = 341
end
object lbl508Required: TVA508StaticText [37]
Name = 'lbl508Required'
Left = 6
Top = 318
Width = 135
Height = 15
Alignment = taLeftJustify
Caption = ' * Indicates a Required Field'
TabOrder = 1
ShowAccelChar = True
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
( (
'Component = txtRate' 'Component = txtRate'
'Status = stsDefault') 'Label = lblInfusionRate'
'Status = stsOK')
( (
'Component = cboPriority' 'Component = cboPriority'
'Status = stsDefault') 'Label = lblPriority'
'Status = stsOK')
( (
'Component = grdSelected' 'Component = grdSelected'
'Status = stsDefault') 'Status = stsDefault')
@ -520,7 +561,8 @@ inherited frmODMedIV: TfrmODMedIV
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = txtXDuration' 'Component = txtXDuration'
'Status = stsDefault') 'Label = lblLimit'
'Status = stsOK')
( (
'Component = pnlCombo' 'Component = pnlCombo'
'Status = stsDefault') 'Status = stsDefault')
@ -535,13 +577,16 @@ inherited frmODMedIV: TfrmODMedIV
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = cboRoute' 'Component = cboRoute'
'Status = stsDefault') 'Label = lblRoute'
'Status = stsOK')
( (
'Component = cboSchedule' 'Component = cboSchedule'
'Status = stsDefault') 'Label = lblSchedule'
'Status = stsOK')
( (
'Component = cboType' 'Component = cboType'
'Status = stsDefault') 'Label = lblType'
'Status = stsOK')
( (
'Component = chkPRN' 'Component = chkPRN'
'Status = stsDefault') 'Status = stsDefault')
@ -550,7 +595,8 @@ inherited frmODMedIV: TfrmODMedIV
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = memOrder' 'Component = memOrder'
'Status = stsDefault') 'Label = Label1'
'Status = stsOK')
( (
'Component = cmdAccept' 'Component = cmdAccept'
'Status = stsDefault') 'Status = stsDefault')
@ -568,15 +614,53 @@ inherited frmODMedIV: TfrmODMedIV
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = cboInfusionTime' 'Component = cboInfusionTime'
'Status = stsDefault') 'Text = Infusion Rate Time'
'Status = stsOK')
( (
'Component = cboDuration' 'Component = cboDuration'
'Status = stsDefault') 'Text = Duration/Volume Units'
'Status = stsOK')
( (
'Component = lblAdminTime' 'Component = lblAdminTime'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = lblFirstDose' 'Component = lblFirstDose'
'Status = stsDefault')
(
'Component = cboAddFreq'
'Status = stsDefault')
(
'Component = lbl508Required'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object VA508CompOrderSig: TVA508ComponentAccessibility
Component = memOrder
OnStateQuery = VA508CompOrderSigStateQuery
Left = 24
Top = 368
end
object VA508CompRoute: TVA508ComponentAccessibility
Component = cboRoute
OnInstructionsQuery = VA508CompRouteInstructionsQuery
Left = 104
Top = 240
end
object VA508CompType: TVA508ComponentAccessibility
Component = cboType
OnInstructionsQuery = VA508CompTypeInstructionsQuery
Left = 224
Top = 280
end
object VA508CompSchedule: TVA508ComponentAccessibility
Component = cboSchedule
OnInstructionsQuery = VA508CompScheduleInstructionsQuery
Left = 384
Top = 240
end
object VA508CompGrdSelected: TVA508ComponentAccessibility
Component = grdSelected
OnCaptionQuery = VA508CompGrdSelectedCaptionQuery
Left = 288
Top = 64
end
end end

548
CPRS-Chart/Orders/fODMedIV.pas
View File

@ -44,6 +44,15 @@ type
lblFirstDose: TVA508StaticText; lblFirstDose: TVA508StaticText;
txtAllIVRoutes: TLabel; txtAllIVRoutes: TLabel;
lblTypeHelp: TLabel; lblTypeHelp: TLabel;
cboAddFreq: TCaptionComboBox;
lblAddFreq: TLabel;
lblPrevAddFreq: TLabel;
lbl508Required: TVA508StaticText;
VA508CompOrderSig: TVA508ComponentAccessibility;
VA508CompRoute: TVA508ComponentAccessibility;
VA508CompType: TVA508ComponentAccessibility;
VA508CompSchedule: TVA508ComponentAccessibility;
VA508CompGrdSelected: TVA508ComponentAccessibility;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure tabFluidChange(Sender: TObject); procedure tabFluidChange(Sender: TObject);
procedure cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction, procedure cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction,
@ -58,10 +67,8 @@ type
procedure cmdRemoveClick(Sender: TObject); procedure cmdRemoveClick(Sender: TObject);
procedure FormResize(Sender: TObject); procedure FormResize(Sender: TObject);
procedure txtSelectedExit(Sender: TObject); procedure txtSelectedExit(Sender: TObject);
procedure cboSelectedExit(Sender: TObject);
procedure ControlChange(Sender: TObject); procedure ControlChange(Sender: TObject);
procedure txtSelectedChange(Sender: TObject); procedure txtSelectedChange(Sender: TObject);
procedure cboSelectedChange(Sender: TObject);
procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState); State: TGridDrawState);
procedure FormKeyDown(Sender: TObject; var Key: Word; procedure FormKeyDown(Sender: TObject; var Key: Word;
@ -93,6 +100,34 @@ type
procedure txtAllIVRoutesClick(Sender: TObject); procedure txtAllIVRoutesClick(Sender: TObject);
procedure cboRouteClick(Sender: TObject); procedure cboRouteClick(Sender: TObject);
procedure lblTypeHelpClick(Sender: TObject); procedure lblTypeHelpClick(Sender: TObject);
procedure cboSelectedCloseUp(Sender: TObject);
procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboPriorityKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboAddFreqKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboAddFreqCloseUp(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure txtSelectedKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboSelectedKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboTypeKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboRouteKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboScheduleKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure VA508CompOrderSigStateQuery(Sender: TObject; var Text: string);
procedure VA508CompRouteInstructionsQuery(Sender: TObject;
var Text: string);
procedure VA508CompTypeInstructionsQuery(Sender: TObject; var Text: string);
procedure VA508CompScheduleInstructionsQuery(Sender: TObject;
var Text: string);
procedure VA508CompGrdSelectedCaptionQuery(Sender: TObject;
var Text: string);
private private
FInpatient: Boolean; FInpatient: Boolean;
FNSSAdminTime: string; FNSSAdminTime: string;
@ -101,13 +136,13 @@ type
OAddIEN: integer; OAddIEN: integer;
OSchedule: string; OSchedule: string;
oAdmin: string; oAdmin: string;
Action: integer;
OrderIEN: string; OrderIEN: string;
FAdminTimeText: string; FAdminTimeText: string;
JAWSON: boolean; JAWSON: boolean;
FOriginalDurationType: integer; FOriginalDurationType: integer;
FOriginalInfusionType: integer; FOriginalInfusionType: integer;
FInitialOrderID: boolean; FIVTypeDefined: boolean;
//FInitialOrderID: boolean;
procedure SetValuesFromResponses; procedure SetValuesFromResponses;
procedure DoSetFontSize( FontSize: integer); procedure DoSetFontSize( FontSize: integer);
procedure ClickOnGridCell; procedure ClickOnGridCell;
@ -118,7 +153,11 @@ type
procedure DisplayDoseNow(Status: boolean); procedure DisplayDoseNow(Status: boolean);
procedure UpdateDuration(SchType: string); procedure UpdateDuration(SchType: string);
procedure ClearAllFields; procedure ClearAllFields;
function UpdateAddFreq(OI: integer): string;
function IsAltCtrl_L_Pressed(Shift : TShiftState; Key : Word) : Boolean;
procedure SetCtrlAlt_L_LabelAccessText(var Text: string; theLabel : TLabel);
public public
OrdAction: integer;
procedure InitDialog; override; procedure InitDialog; override;
procedure SetupDialog(OrderAction: Integer; const ID: string); override; procedure SetupDialog(OrderAction: Integer; const ID: string); override;
procedure Validate(var AnErrMsg: string); override; procedure Validate(var AnErrMsg: string); override;
@ -151,6 +190,7 @@ type
Amount: Integer; Amount: Integer;
Units: string; Units: string;
Volumes: string; Volumes: string;
AddFreq: string;
end; end;
const const
@ -167,6 +207,9 @@ const
TX_NO_INFUSION_UNIT = 'Invalid Unit of Time, select either "Minutes" or "Hours" for the Infusion Length'; TX_NO_INFUSION_UNIT = 'Invalid Unit of Time, select either "Minutes" or "Hours" for the Infusion Length';
TX_BAD_ROUTE = 'Route cannot be free-text'; TX_BAD_ROUTE = 'Route cannot be free-text';
TX_LEADING_NUMERIC = 'this additive must start with a leading numeric value'; TX_LEADING_NUMERIC = 'this additive must start with a leading numeric value';
TX_BAD_BAG = 'A valid additive frequency must be entered for ';
Tx_BAG_NO_COMMENTS ='"See Comments" entered for additive ';
TX_BAG_NO_COMMENTS1 = ' no comments defined for this order.';
(* (*
{ TIVComponent methods } { TIVComponent methods }
@ -199,6 +242,7 @@ begin
Close; Close;
Exit; Exit;
end; end;
OrdAction := -1;
DoSetFontSize(MainFontSize); DoSetFontSize(MainFontSize);
FillerID := 'PSIV'; // does 'on Display' order check **KCM** FillerID := 'PSIV'; // does 'on Display' order check **KCM**
StatusText('Loading Dialog Definition'); StatusText('Loading Dialog Definition');
@ -220,15 +264,36 @@ end;
procedure TfrmODMedIV.FormResize(Sender: TObject); procedure TfrmODMedIV.FormResize(Sender: TObject);
var var
bottom: integer; bottom: integer;
isNewOrder: boolean;
begin begin
inherited; inherited;
if OrdAction in [ORDER_COPY, ORDER_EDIT] then isNewOrder := false
else isNewOrder := True;
with grdSelected do with grdSelected do
begin begin
ColWidths[1] := Canvas.TextWidth(' 10000 ') + GetSystemMetrics(SM_CXVSCROLL); ColWidths[1] := Canvas.TextWidth(' 10000 ') + GetSystemMetrics(SM_CXVSCROLL);
ColWidths[2] := Canvas.TextWidth('meq.') + GetSystemMetrics(SM_CXVSCROLL); ColWidths[2] := Canvas.TextWidth('meq.') + GetSystemMetrics(SM_CXVSCROLL);
ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - 4; //AGP ADDITIVE FREQUENCY CHANGES
ColWidths[3] := Canvas.TextWidth(lblAddFreq.Caption + ' ') + GetSystemMetrics(SM_CXVSCROLL);
if IsNewOrder = false then
begin
ColWidths[4] := Canvas.TextWidth(lblPrevAddFreq.Caption) + GetSystemMetrics(SM_CXVSCROLL);
ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - ColWidths[4] - 5;
end
else
begin
ColWidths[4] := 0;
ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - ColWidths[4] - 25;
end;
end; end;
lblAmount.Left := grdSelected.Left + grdSelected.ColWidths[0]; lblAmount.Left := grdSelected.Left + grdSelected.ColWidths[0];
lblAddFreq.Left := grdSelected.Left + grdSelected.ColWidths[0] + grdSelected.ColWidths[1] + grdSelected.ColWidths[2];
if isNewOrder = false then
begin
lblPrevAddFreq.Visible := True;
lblPrevAddFreq.Left := grdSelected.Left + grdSelected.ColWidths[0] + grdSelected.ColWidths[1] + grdSelected.ColWidths[2] + grdSelected.ColWidths[3];
end
else lblPrevAddFreq.Visible := False;
self.cboType.SelLength := 0; self.cboType.SelLength := 0;
self.cboInfusionTime.SelLength := 0; self.cboInfusionTime.SelLength := 0;
self.cboDuration.SelLength := 0; self.cboDuration.SelLength := 0;
@ -242,9 +307,10 @@ begin
self.lblFirstDose.Width := TextWidthByFont(self.lblFirstDose.Font.Handle, self.lblFirstDose.Caption + ' '); self.lblFirstDose.Width := TextWidthByFont(self.lblFirstDose.Font.Handle, self.lblFirstDose.Caption + ' ');
self.lblAdminTime.Top := self.chkDoseNow.Top + self.chkDoseNow.Height + 2; self.lblAdminTime.Top := self.chkDoseNow.Top + self.chkDoseNow.Height + 2;
self.lblFirstDose.Top := self.lblAdminTime.Top + self.lblAdminTime.Height + 2; self.lblFirstDose.Top := self.lblAdminTime.Top + self.lblAdminTime.Height + 2;
if self.Label1.Top < (self.lblFirstDose.Top + self.lblFirstDose.Height) then self.lbl508Required.Top := self.lblFirstDose.Top + self.lblFirstDose.Height + 5;
if self.Label1.Top < (self.lbl508Required.Top + self.lbl508Required.Height) then
begin begin
self.Label1.Top := self.lblFirstDose.Top + self.lblFirstDose.Height + 2; self.Label1.Top := self.lbl508Required.Top + self.lbl508Required.Height + 5;
self.memOrder.Top := self.Label1.Top + self.Label1.Height; self.memOrder.Top := self.Label1.Top + self.Label1.Height;
end; end;
end; end;
@ -261,6 +327,8 @@ begin
//grdSelected.Selection := NOSELECTION; //grdSelected.Selection := NOSELECTION;
//FRouteConflict := False; //FRouteConflict := False;
//lblTypeHelp.Hint := IVTypeHelpText; //lblTypeHelp.Hint := IVTypeHelpText;
ClearAllFields;
//FIVTypeDefined := false;
lblType.Hint := IVTypeHelpText; lblType.Hint := IVTypeHelpText;
cboType.Hint := IVTYpeHelpText; cboType.Hint := IVTYpeHelpText;
with grdSelected do for i := 0 to RowCount - 1 do with grdSelected do for i := 0 to RowCount - 1 do
@ -285,7 +353,6 @@ begin
LoadSchedules(cboSchedule.Items, patient.Inpatient); LoadSchedules(cboSchedule.Items, patient.Inpatient);
//if (Patient.Inpatient) and (cboSchedule.Items.IndexOfName('Other')<0) then //if (Patient.Inpatient) and (cboSchedule.Items.IndexOfName('Other')<0) then
if cboSchedule.Items.IndexOf('Other') = -1 then cboSchedule.Items.Add('OTHER'); if cboSchedule.Items.IndexOf('Other') = -1 then cboSchedule.Items.Add('OTHER');
cboSchedule.Enabled := False; cboSchedule.Enabled := False;
lblschedule.Enabled := False; lblschedule.Enabled := False;
if cboInfusionTime.Items.Count = 0 then if cboInfusionTime.Items.Count = 0 then
@ -309,6 +376,13 @@ begin
if (chkDoseNow.Visible = true) and (chkDoseNow.Checked = true) then chkDoseNow.Checked := false; if (chkDoseNow.Visible = true) and (chkDoseNow.Checked = true) then chkDoseNow.Checked := false;
chkDoseNow.Visible := false; chkDoseNow.Visible := false;
chkPRN.Enabled := false; chkPRN.Enabled := false;
//AGP ADDITIVE FREQUENCY CHANGES
if cboAddFreq.Items.Count = 0 then
begin
cboAddFreq.Items.Add('1 Bag/Day');
cboAddFreq.Items.Add('All Bags');
cboAddFreq.Items.Add('See Comments');
end;
end; end;
tabFluid.TabIndex := 0; tabFluid.TabIndex := 0;
tabFluidChange(Self); // this makes cboSolution visible tabFluidChange(Self); // this makes cboSolution visible
@ -329,6 +403,8 @@ begin
OSchedule := ''; OSchedule := '';
oAdmin := ''; oAdmin := '';
self.txtAllIVRoutes.Visible := false; self.txtAllIVRoutes.Visible := false;
memorder.text := '';
memOrder.Lines.Clear;
end; end;
function TfrmODMedIV.IVTypeHelpText: string; function TfrmODMedIV.IVTypeHelpText: string;
@ -340,6 +416,12 @@ begin
'Examples:' + CRLF + 'Continuous = Infusion/drip' + CRLF + 'Intermittent = IVP/IVPB'; 'Examples:' + CRLF + 'Continuous = Infusion/drip' + CRLF + 'Intermittent = IVP/IVPB';
end; end;
procedure TfrmODMedIV.SetCtrlAlt_L_LabelAccessText(var Text: string; theLabel : TLabel);
begin
if theLabel.Visible then
Text := 'Press Ctrl + Alt + L to access ' + theLabel.Caption;
end;
procedure TfrmODMedIV.lblTypeHelpClick(Sender: TObject); procedure TfrmODMedIV.lblTypeHelpClick(Sender: TObject);
var var
str: string; str: string;
@ -454,10 +536,54 @@ begin
else self.lblAdminTime.TabStop := false; else self.lblAdminTime.TabStop := false;
end; end;
procedure TfrmODMedIV.VA508CompRouteInstructionsQuery(
Sender: TObject; var Text: string);
begin
inherited;
SetCtrlAlt_L_LabelAccessText(Text, txtAllIVRoutes);
end;
procedure TfrmODMedIV.VA508CompScheduleInstructionsQuery(Sender: TObject;
var Text: string);
begin
inherited;
SetCtrlAlt_L_LabelAccessText(Text, txtNSS);
end;
procedure TfrmODMedIV.VA508CompTypeInstructionsQuery(Sender: TObject;
var Text: string);
begin
inherited;
SetCtrlAlt_L_LabelAccessText(Text, lblTypeHelp);
end;
procedure TfrmODMedIV.VA508CompGrdSelectedCaptionQuery(Sender: TObject;
var Text: string);
begin
inherited;
if grdSelected.Col = 0 then
Text := lblComponent.Caption
else if grdSelected.Col = 1 then
Text := lblAmount.Caption
else if grdSelected.Col = 2 then
Text := lblAmount.Caption + ', Unit'
else if grdSelected.Col = 3 then
Text := lblAddFreq.Caption
else if grdSelected.Col = 4 then
Text := lblPrevAddFreq.Caption;
end;
procedure TfrmODMedIV.VA508CompOrderSigStateQuery(Sender: TObject;
var Text: string);
begin
inherited;
Text := memOrder.Text;
end;
procedure TfrmODMedIV.Validate(var AnErrMsg: string); procedure TfrmODMedIV.Validate(var AnErrMsg: string);
var var
DispWarning, ItemOK, Result: Boolean; DispWarning, ItemOK, Result: Boolean;
LDec,RDec,x, tempStr, iunit, infError: string; LDec,RDec,x, tempStr, iunit, infError, Bag: string;
digits, i, j, Len, temp, Value: Integer; digits, i, j, Len, temp, Value: Integer;
procedure SetError(const x: string); procedure SetError(const x: string);
@ -498,6 +624,24 @@ begin
Exit; Exit;
end; end;
end; end;
//AGP ADDITIVE FREQUENCY CHANGES
if MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous' then
begin
Bag := (Cells[3, i]);
if Length(Bag) = 0 then
begin
SetError(TX_BAD_BAG + cells[0, i]);
end
else if cboAddFreq.Items.IndexOf(Bag) = -1 then
begin
SetError(TX_BAD_BAG + cells[0, i]);
end
else if (MixedCase(Bag) = 'See Comments') and ((self.memComments.Text = '') or (self.memComments.Text = CRLF)) then
begin
SetError(Tx_BAG_NO_COMMENTS + cells[0,i] + Tx_BAG_NO_COMMENTS1);
end;
end;
end; end;
end; end;
end; end;
@ -573,13 +717,19 @@ begin
if (iunit = 'Minutes') and (Len > 4) then setError('Infuse Over Time cannot exceed 4 spaces for ' + iunit) if (iunit = 'Minutes') and (Len > 4) then setError('Infuse Over Time cannot exceed 4 spaces for ' + iunit)
else if (iunit = 'Hours') and (Len > 2) then setError('Infuse Over Time cannot exceed 2 spaces for ' + iunit); else if (iunit = 'Hours') and (Len > 2) then setError('Infuse Over Time cannot exceed 2 spaces for ' + iunit);
end; end;
if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text = '') then SetError(TX_NO_SCHEDULE); if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text = '') and (chkPRN.Checked = false) then SetError(TX_NO_SCHEDULE);
if (cboSchedule.ItemIndex > -1) and (cboSchedule.Text = '') then
begin
cboSchedule.ItemIndex := -1;
SetError(TX_NO_SCHEDULE)
end;
if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then SetError(TX_BAD_SCHEDULE); if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then SetError(TX_BAD_SCHEDULE);
end; end;
if txtXDuration.Text = '' then if txtXDuration.Text = '' then
begin begin
if AnErrMsg = '' then self.FInitialOrderID := True; if AnErrMsg = '' then exit;
exit; //if AnErrMsg = '' then self.FInitialOrderID := True;
//exit;
end; end;
Len := Length(txtXDuration.Text); Len := Length(txtXDuration.Text);
if LeftStr(txtXDuration.Text,1) <> '.' then if LeftStr(txtXDuration.Text,1) <> '.' then
@ -606,7 +756,7 @@ begin
else if (Value < 0) or (Value > 2000000) then else if (Value < 0) or (Value > 2000000) then
SetError('Duration with a unit of "doses" must be greater then 0 and less then 2000000'); SetError('Duration with a unit of "doses" must be greater then 0 and less then 2000000');
end; end;
if AnErrMsg = '' then self.FInitialOrderID := True; //if AnErrMsg = '' then self.FInitialOrderID := True;
end; end;
@ -628,17 +778,19 @@ end;
procedure TfrmODMedIV.SetValuesFromResponses; procedure TfrmODMedIV.SetValuesFromResponses;
var var
x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute: string; x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute, PreAddFreq: string;
AnInstance, i, idx: Integer; AnInstance, i, idx, j: Integer;
AResponse: TResponse; AResponse, AddFreqResp: TResponse;
AnIVComponent: TIVComponent; AnIVComponent: TIVComponent;
AllIVRoute: TStringList; AllIVRoute: TStringList;
PQO: boolean; PQO: boolean;
begin begin
Changing := True; Changing := True;
self.FInitialOrderID := false; //self.FInitialOrderID := false;
with Responses do with Responses do
begin begin
SetControl(cboType, 'TYPE', 1);
if cboType.ItemIndex > -1 then FIVTypeDefined := True;
FInpatient := OrderForInpatient; FInpatient := OrderForInpatient;
AnInstance := NextInstance('ORDERABLE', 0); AnInstance := NextInstance('ORDERABLE', 0);
while AnInstance > 0 do while AnInstance > 0 do
@ -681,6 +833,7 @@ begin
if AnIVComponent.Amount <> 0 then if AnIVComponent.Amount <> 0 then
Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount); Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
Cells[2, RowCount - 1] := AnIVComponent.Units; Cells[2, RowCount - 1] := AnIVComponent.Units;
Cells[3, RowCount - 1] := 'N/A';
end; end;
end; end;
AResponse := FindResponseByName('VOLUME', AnInstance); AResponse := FindResponseByName('VOLUME', AnInstance);
@ -720,6 +873,19 @@ begin
AnIVComponent.Amount := StrToIntDef(Piece(x, U, 2), 0); AnIVComponent.Amount := StrToIntDef(Piece(x, U, 2), 0);
AnIVComponent.Units := Piece(x, U, 1); AnIVComponent.Units := Piece(x, U, 1);
AnIVComponent.Volumes := Copy(x, Pos(U, x) + 1, Length(x)); AnIVComponent.Volumes := Copy(x, Pos(U, x) + 1, Length(x));
//AGP ADDITIVE FREQUENCY CHANGES
AnIVComponent.AddFreq := '';
PreAddFreq := '';
AddFreqResp := FindResponseByName('ADDFREQ', AnInstance);
if AddFreqResp <> nil then
begin
if cboAddFreq.Items.IndexOf(AddFreqResp.IValue) = -1 then
begin
AnIvComponent.AddFreq := '';
end
else AnIvComponent.AddFreq := AddFreqResp.IValue;
PreAddFreq := AddFreqResp.IValue;
end;
with grdSelected do with grdSelected do
begin begin
if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1; if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
@ -728,6 +894,8 @@ begin
if AnIVComponent.Amount <> 0 then if AnIVComponent.Amount <> 0 then
Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount); Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
Cells[2, RowCount - 1] := AnIVComponent.Units; Cells[2, RowCount - 1] := AnIVComponent.Units;
Cells[3, RowCount -1] := AnIVComponent.AddFreq;
if OrdAction in [ORDER_COPY, ORDER_EDIT] then Cells[4, RowCount -1] := PreAddFreq;
end; end;
end; end;
AResponse := FindResponseByName('STRENGTH', AnInstance); AResponse := FindResponseByName('STRENGTH', AnInstance);
@ -802,7 +970,7 @@ begin
SetSchedule(tempSch); SetSchedule(tempSch);
//if (cboSchedule.ItemIndex > -1) then lblAdminTime.Caption := 'Admin. Time: ' + Piece(cboSchedule.Items.strings[cboSchedule.itemindex],U,5); //if (cboSchedule.ItemIndex > -1) then lblAdminTime.Caption := 'Admin. Time: ' + Piece(cboSchedule.Items.strings[cboSchedule.itemindex],U,5);
//if (cboSchedule.ItemIndex > -1) and (Piece(lblAdminTime.Caption, ':' ,2) = ' ') then lblAdminTime.Caption := 'Admin. Time: ' + AdminTime; //if (cboSchedule.ItemIndex > -1) and (Piece(lblAdminTime.Caption, ':' ,2) = ' ') then lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
if (Action in [ORDER_COPY, ORDER_EDIT]) then if (OrdAction in [ORDER_COPY, ORDER_EDIT]) then
begin begin
TempOrder := Piece(OrderIEN,';',1); TempOrder := Piece(OrderIEN,';',1);
TempOrder := Copy(tempOrder, 2, Length(tempOrder)); TempOrder := Copy(tempOrder, 2, Length(tempOrder));
@ -811,7 +979,7 @@ begin
AResponse := Responses.FindResponseByName('ADMIN', 1); AResponse := Responses.FindResponseByName('ADMIN', 1);
if AResponse <> nil then AdminTime := AResponse.EValue; if AResponse <> nil then AdminTime := AResponse.EValue;
//lblAdminTime.Caption := 'Admin. Time: ' + AdminTime; //lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
if cboSchedule.ItemIndex > -1 then if (cboSchedule.ItemIndex > -1) and (AdminTime <> '') then
begin begin
tmpSch := cboSchedule.Items.Strings[cboSchedule.itemindex]; tmpSch := cboSchedule.Items.Strings[cboSchedule.itemindex];
setPiece(tmpSch,U,4,AdminTime); setPiece(tmpSch,U,4,AdminTime);
@ -847,6 +1015,8 @@ begin
cboInfusionTime.Text := 'Minutes'; cboInfusionTime.Text := 'Minutes';
cboInfusionTime.itemindex := 0; cboInfusionTime.itemindex := 0;
end; end;
For j := 0 to grdSelected.RowCount -1 do
grdSelected.Cells[3,j] := 'N/A';
end end
else else
begin begin
@ -889,15 +1059,15 @@ end;
procedure TfrmODMedIV.SetupDialog(OrderAction: Integer; const ID: string); procedure TfrmODMedIV.SetupDialog(OrderAction: Integer; const ID: string);
begin begin
inherited; inherited;
Action := OrderAction; OrdAction := OrderAction;
OrderIEN := id; OrderIEN := id;
self.FInitialOrderID := True; //self.FInitialOrderID := True;
if self.EvtID > 0 then FAdminTimeText := 'To Be Determined'; if self.EvtID > 0 then FAdminTimeText := 'To Be Determined';
if isIMO = true then self.Caption := 'Clinic ' + self.Caption;
if (isIMO) or ((patient.Inpatient = true) and (encounter.Location <> patient.Location)) and (FAdminTimeText = '') then if (isIMO) or ((patient.Inpatient = true) and (encounter.Location <> patient.Location)) and (FAdminTimeText = '') then
FAdminTimeText := 'Not defined for Clinic Locations'; FAdminTimeText := 'Not defined for Clinic Locations';
if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
begin begin
SetValuesFromResponses; SetValuesFromResponses;
end; end;
end; end;
@ -927,16 +1097,13 @@ end;
procedure TfrmODMedIV.cboSolutionNeedData(Sender: TObject; const StartFrom: string; procedure TfrmODMedIV.cboSolutionNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer); Direction, InsertAt: Integer);
var
CurString: string;
begin begin
inherited; cboSolution.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.IVB RX'));
if (Direction = 1) then
CurString := AnsiUpperCase(StartFrom) + ' ';
cboSolution.ForDataUse(SubSetOfOrderItems(CurString, Direction, 'S.IVB RX'));
end; end;
procedure TfrmODMedIV.cbotypeChange(Sender: TObject); procedure TfrmODMedIV.cbotypeChange(Sender: TObject);
var
i: integer;
begin begin
inherited; inherited;
//if (self.cbotype.Text = 'Intermittent') or (self.cboType.itemIndex = 1) then //if (self.cbotype.Text = 'Intermittent') or (self.cboType.itemIndex = 1) then
@ -954,7 +1121,16 @@ begin
chkPRN.Enabled := True; chkPRN.Enabled := True;
lblInfusionRate.Caption := 'Infuse Over Time (Optional)'; lblInfusionRate.Caption := 'Infuse Over Time (Optional)';
cboInfusionTime.Enabled := true; cboInfusionTime.Enabled := true;
cboDuration.Items.Add('doses'); if cboDuration.items.IndexOf('doses') = -1 then cboDuration.Items.Add('doses');
//AGP ADDITIVE FREQUECNY CHANGES
lblAddFreq.Caption := 'Additive Frequency';
for i := 0 to grdselected.RowCount - 1 do
begin
if (TIVComponent(grdselected.Objects[0, i]) <> nil) and (TIVComponent(grdselected.Objects[0, i]).Fluid = 'A') then
begin
grdSelected.Cells[3, i] := 'N/A';
end;
end;
end end
//else if (self.cbotype.Text = 'Continuous') or (self.cboType.itemIndex = 0) then //else if (self.cbotype.Text = 'Continuous') or (self.cboType.itemIndex = 0) then
else else
@ -974,23 +1150,50 @@ begin
lblAdminTime.Visible := false; lblAdminTime.Visible := false;
updateDuration(''); updateDuration('');
cboduration.Items.Delete(cboDuration.Items.IndexOf('doses')); cboduration.Items.Delete(cboDuration.Items.IndexOf('doses'));
lblAddFreq.Caption := 'Additive Frequency*';
if FIVTypeDefined = True then
begin
for i := 0 to grdselected.RowCount - 1 do
begin
if (TIVComponent(grdselected.Objects[0, i]) <> nil) and (TIVComponent(grdselected.Objects[0, i]).Fluid = 'A') then
begin
grdSelected.Cells[3, i] := '';
end;
end;
end;
end; end;
FIVTypeDefined := True;
self.txtRate.Text := ''; self.txtRate.Text := '';
ControlChange(Sender); ControlChange(Sender);
end; end;
procedure TfrmODMedIV.cboTypeKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if IsAltCtrl_L_Pressed(Shift, Key) then
lblTypeHelpClick(lblTypeHelp);
end;
function TfrmODMedIV.IsAltCtrl_L_Pressed(Shift : TShiftState; Key : Word) : Boolean;
begin
Result := (ssCtrl in Shift) and (ssAlt in Shift) and (Key = Ord('L'));
end;
procedure TfrmODMedIV.chkDoseNowClick(Sender: TObject); procedure TfrmODMedIV.chkDoseNowClick(Sender: TObject);
Const Const
T = '"'; T = '"';
T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication.'; T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication.';
T2 = #13#13'The first order''s administrative schedule is "'; T2 = #13#13'The first order''s administrative schedule is "';
T3 = #13'The second order''s administrative schedule is "'; T3 = #13'The second order''s administrative schedule is "';
T4 = #13#13'Do you want to continue?'; T4 = #13#13'Do you want to continue?';
T5 = '" and a priority of "';
T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"'; T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"';
T2A = ' in addition to the one you are placing for the same medication.'; T2A = ' in addition to the one you are placing for the same medication.';
var var
medNm: string; medNm: string;
theSch: string; theSch: string;
ordPriority: string;
//SchID: integer; //SchID: integer;
begin begin
inherited; inherited;
@ -999,10 +1202,12 @@ begin
medNm := 'Test'; medNm := 'Test';
//SchID := cboSchedule.ItemIndex; //SchID := cboSchedule.ItemIndex;
theSch := cboSchedule.Text; theSch := cboSchedule.Text;
ordPriority := cboPriority.SelText;
if length(theSch)>0 then if length(theSch)>0 then
begin begin
//if (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then //if (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
if (InfoBox(T1+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then //if (InfoBox(T1+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
if (InfoBox(T1+T2+'NOW'+T5+ordPriority+T+T3+theSch+T5+ordPriority+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
begin begin
chkDoseNow.Checked := False; chkDoseNow.Checked := False;
Exit; Exit;
@ -1088,17 +1293,19 @@ begin
Cells[0, RowCount - 1] := AnIVComponent.Name; Cells[0, RowCount - 1] := AnIVComponent.Name;
Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount); Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
Cells[2, RowCount - 1] := AnIVComponent.Units; Cells[2, RowCount - 1] := AnIVComponent.Units;
Cells[3, RowCount - 1] := 'N/A';
Row := RowCount - 1; Row := RowCount - 1;
if Length(Piece(AnIVComponent.Volumes, U, 2)) > 0 then Col := 1 else Col := 0; if Length(Piece(AnIVComponent.Volumes, U, 2)) > 0 then Col := 1 else Col := 0;
if RowCount = 1 then // switch to additives after 1st IV (* if RowCount = 1 then // switch to additives after 1st IV
begin begin
tabFluid.TabIndex := 1; tabFluid.TabIndex := 1;
tabFluidChange(Self); tabFluidChange(Self);
end; end; *)
end; end;
Application.ProcessMessages; //CQ: 10157 Application.ProcessMessages; //CQ: 10157
ClickOnGridCell;
updateRoute; updateRoute;
ClickOnGridCell;
//updateRoute;
ControlChange(Sender); ControlChange(Sender);
//updateRoute(routeIEN); //updateRoute(routeIEN);
end; end;
@ -1116,13 +1323,35 @@ end;
procedure TfrmODMedIV.cboAdditiveNeedData(Sender: TObject; const StartFrom: string; procedure TfrmODMedIV.cboAdditiveNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer); Direction, InsertAt: Integer);
var begin
CurString: string; cboAdditive.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.IVA RX'));
end;
procedure TfrmODMedIV.cboAddFreqCloseUp(Sender: TObject);
begin begin
inherited; inherited;
if (Direction = 1) then with cboAddFreq do
CurString := AnsiUpperCase(StartFrom) + ' '; begin
cboAdditive.ForDataUse(SubSetOfOrderItems(CurString, Direction, 'S.IVA RX')); if tag < 0 then exit;
grdSelected.Cells[Tag div 256, Tag mod 256] := MixedCase(items.Strings[itemindex]);
Tag := -1;
Hide;
ControlChange(Sender);
TControl(self.grdSelected).Enabled := True;
ActiveControl := self.grdSelected;
end;
grdSelected.Refresh;
end;
procedure TfrmODMedIV.cboAddFreqKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_RETURN) or (Key = VK_Tab) then
begin
cboAddFreqCloseUp(cboAddFreq);
Key := 0;
end;
end; end;
procedure TfrmODMedIV.cboDurationChange(Sender: TObject); procedure TfrmODMedIV.cboDurationChange(Sender: TObject);
@ -1178,6 +1407,13 @@ begin
end; end;
end; end;
procedure TfrmODMedIV.cboPriorityKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboPriority.Text = '') then cboPriority.ItemIndex := -1;
end;
procedure TfrmODMedIV.cboRouteChange(Sender: TObject); procedure TfrmODMedIV.cboRouteChange(Sender: TObject);
begin begin
inherited; inherited;
@ -1231,6 +1467,21 @@ begin
end; *) end; *)
end; end;
procedure TfrmODMedIV.cboRouteKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if IsAltCtrl_L_Pressed(Shift, Key) then
txtAllIVRoutesClick(txtAllIVRoutes);
end;
procedure TfrmODMedIV.cboRouteKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1;
end;
procedure TfrmODMedIV.cboAdditiveMouseClick(Sender: TObject); procedure TfrmODMedIV.cboAdditiveMouseClick(Sender: TObject);
var var
AnIVComponent: TIVComponent; AnIVComponent: TIVComponent;
@ -1272,6 +1523,7 @@ begin
Objects[0, RowCount - 1] := AnIVComponent; Objects[0, RowCount - 1] := AnIVComponent;
Cells[0, RowCount - 1] := AnIVComponent.Name; Cells[0, RowCount - 1] := AnIVComponent.Name;
Cells[2, RowCount - 1] := AnIVComponent.Units; Cells[2, RowCount - 1] := AnIVComponent.Units;
Cells[3, RowCount -1] := UpdateAddFreq(AnIVComponent.IEN);
Row := RowCount - 1; Row := RowCount - 1;
Col := 1; Col := 1;
end; end;
@ -1301,9 +1553,10 @@ begin
self.cboDuration.ItemIndex := -1; self.cboDuration.ItemIndex := -1;
self.cboDuration.Text := ''; self.cboDuration.Text := '';
self.txtAllIVRoutes.Visible := false; self.txtAllIVRoutes.Visible := false;
self.FInitialOrderID := True; //self.FInitialOrderID := True;
cbotypeChange(self.cboType); cbotypeChange(self.cboType);
if self.cboroute.Items.Count > 0 then self.cboRoute.Clear; if self.cboroute.Items.Count > 0 then self.cboRoute.Clear;
FIVTypeDefined := false;
end; end;
procedure TfrmODMedIV.ClickOnGridCell; procedure TfrmODMedIV.ClickOnGridCell;
@ -1323,13 +1576,20 @@ var
Show; Show;
SetFocus; SetFocus;
if AControl is TComboBox then //CQ: 10157 if AControl is TComboBox then //CQ: 10157
TComboBox(AControl).DroppedDown := True; begin
TComboBox(AControl).DroppedDown := True;
TControl(self.grdSelected).Enabled := false;
end;
end; end;
end; end;
begin begin
AnIVComponent := TIVComponent(grdSelected.Objects[0, grdSelected.Row]); AnIVComponent := TIVComponent(grdSelected.Objects[0, grdSelected.Row]);
if (AnIVComponent = nil) or (grdSelected.Col = 0) then Exit; if (AnIVComponent = nil) or (grdSelected.Col = 0) then
begin
if (AnIVComponent <> nil) and (grdSelected.Col = 0) then grdSelected.Refresh;
Exit;
end;
// allow selection if more the 1 unit to choose from // allow selection if more the 1 unit to choose from
if (grdSelected.Col = 2) and (Length(Piece(AnIVComponent.Units, U, 2)) > 0) then if (grdSelected.Col = 2) and (Length(Piece(AnIVComponent.Units, U, 2)) > 0) then
begin begin
@ -1353,6 +1613,13 @@ begin
txtSelected.Tag := (grdSelected.Col * 256) + grdSelected.Row; txtSelected.Tag := (grdSelected.Col * 256) + grdSelected.Row;
PlaceControl(txtSelected); PlaceControl(txtSelected);
end; end;
// AGP ADDITIVE FREQUENCY CHANGES
if (Self.cboType.ItemIndex < 1) and (grdSelected.Col = 3) and (AnIVComponent.Fluid = 'A') then
begin
cboAddFreq.ItemIndex := cboAddFreq.Items.IndexOf(grdSelected.Cells[grdSelected.Col, grdSelected.Row]);
cboAddFreq.Tag := (grdSelected.Col * 256) + grdSelected.Row;
PlaceControl(cboAddFreq);
end;
end; end;
procedure TfrmODMedIV.txtSelectedChange(Sender: TObject); // text editor for grid procedure TfrmODMedIV.txtSelectedChange(Sender: TObject); // text editor for grid
@ -1375,9 +1642,26 @@ begin
Tag := -1; Tag := -1;
Hide; Hide;
end; end;
grdSelected.Refresh;
end;
procedure TfrmODMedIV.txtSelectedKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_RETURN) or (Key = VK_Tab) then
begin
ActiveControl := grdSelected;
Key := 0;
end;
end; end;
procedure TfrmODMedIV.cboScheduleChange(Sender: TObject); procedure TfrmODMedIV.cboScheduleChange(Sender: TObject);
var
othSch: string;
idx: integer;
begin begin
inherited; inherited;
if self.txtXDuration.Enabled = true then if self.txtXDuration.Enabled = true then
@ -1385,14 +1669,28 @@ begin
self.txtXDuration.Text := ''; self.txtXDuration.Text := '';
self.cboDuration.ItemIndex := -1; self.cboDuration.ItemIndex := -1;
end; end;
if self.cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3)); if self.cboSchedule.ItemIndex > -1 then
begin
if cboSchedule.ItemIndex = cboSchedule.Items.IndexOf('Other') then
begin
othSch := CreateOtherSchedule;
if length(trim(othSch)) > 1 then
begin
cboSchedule.Items.Add(othSch + U + U + NSSScheduleType + U + NSSAdminTime);
idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
cboSchedule.ItemIndex := idx;
end
else cboSchedule.itemindex := -1;
end;
if cboSchedule.itemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3));
end;
ControlChange(sender); ControlChange(sender);
end; end;
procedure TfrmODMedIV.cboScheduleClick(Sender: TObject); procedure TfrmODMedIV.cboScheduleClick(Sender: TObject);
var var
othSch: string; othSch: string;
idx, i : integer; idx: integer;
begin begin
inherited; inherited;
if cboSchedule.ItemIndex = cboSchedule.Items.IndexOf('Other') then if cboSchedule.ItemIndex = cboSchedule.Items.IndexOf('Other') then
@ -1401,14 +1699,7 @@ begin
if length(trim(othSch)) > 1 then if length(trim(othSch)) > 1 then
begin begin
cboSchedule.Items.Add(othSch + U + U + NSSScheduleType + U + NSSAdminTime); cboSchedule.Items.Add(othSch + U + U + NSSScheduleType + U + NSSAdminTime);
idx := -1; idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
for I := 0 to cboSchedule.Items.Count - 1 do
if Piece(cboSchedule.Items.Strings[i], U, 1) = othSch then
begin
idx := i;
break;
end;
//idx := cboSchedule.Items.IndexOfName(othSch);
cboSchedule.ItemIndex := idx; cboSchedule.ItemIndex := idx;
end; end;
end end
@ -1430,27 +1721,48 @@ begin
cboSchedule.Text := ''; cboSchedule.Text := '';
cboSchedule.SetFocus; cboSchedule.SetFocus;
end; end;
if (cboSchedule.ItemIndex > -1) and (cboSchedule.Text = '') then cboSchedule.ItemIndex := -1;
end; end;
procedure TfrmODMedIV.cboSelectedChange(Sender: TObject); // combo editor for grid procedure TfrmODMedIV.cboScheduleKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if IsAltCtrl_L_Pressed(Shift, Key) then
txtNSSClick(txtNSS);
end;
procedure TfrmODMedIV.cboScheduleKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboSchedule.Text = '') then cboSchedule.ItemIndex := -1;
end;
procedure TfrmODMedIV.cboSelectedCloseUp(Sender: TObject);
begin begin
inherited; inherited;
with cboSelected do with cboSelected do
begin begin
if Tag < 0 then Exit; if tag < 0 then exit;
grdSelected.Cells[Tag div 256, Tag mod 256] := Text; grdSelected.Cells[Tag div 256, Tag mod 256] := MixedCase(items.Strings[itemindex]);
end;
ControlChange(Sender);
end;
procedure TfrmODMedIV.cboSelectedExit(Sender: TObject);
begin
inherited;
with cboSelected do
begin
grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
Tag := -1; Tag := -1;
Hide; Hide;
ControlChange(Sender);
TControl(self.grdSelected).Enabled := True;
ActiveControl := self.grdSelected;
end;
grdSelected.Refresh;
end;
procedure TfrmODMedIV.cboSelectedKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_RETURN) or (Key = VK_Tab) then
begin
cboSelectedCloseUp(cboSelected);
Key := 0;
end; end;
end; end;
@ -1527,6 +1839,8 @@ begin
if IEN > 0 then Responses.Update('ADDITIVE', CurAdd, IntToStr(IEN), Name); if IEN > 0 then Responses.Update('ADDITIVE', CurAdd, IntToStr(IEN), Name);
if Length(Cells[1,i]) > 0 then Responses.Update('STRENGTH', CurAdd, Cells[1,i], Cells[1,i]); if Length(Cells[1,i]) > 0 then Responses.Update('STRENGTH', CurAdd, Cells[1,i], Cells[1,i]);
if Length(Cells[2,i]) > 0 then Responses.Update('UNITS', CurAdd, Cells[2,i], Cells[2,i]); if Length(Cells[2,i]) > 0 then Responses.Update('UNITS', CurAdd, Cells[2,i], Cells[2,i]);
//AGP ADDITIVE FREQUECNY CHANGES
if (Length(Cells[3,i]) > 0) and (Cells[3,i] <> 'N/A') then Responses.Update('ADDFREQ', CurAdd, Cells[3,i], Cells[3,i]);
Inc(CurAdd); Inc(CurAdd);
end; {if Fluid A} end; {if Fluid A}
end; {with AnIVComponent} end; {with AnIVComponent}
@ -1557,8 +1871,9 @@ begin
xlimEx := ''; xlimEx := '';
end; end;
end; end;
if cboType.Text = 'Intermittent' then iType := 'I' if (cboType.ItemIndex > -1) and (cboType.Items.Strings[cboType.ItemIndex] = 'Intermittent') then iType := 'I'
else iType := 'C'; else if (cboType.ItemIndex > -1) and (cboType.Items.Strings[cboType.ItemIndex] = 'Continuous') then iType := 'C'
else iType := '';
Responses.Update('TYPE',1,iType,cboType.Text); Responses.Update('TYPE',1,iType,cboType.Text);
Responses.Update('ROUTE',1,cboRoute.ItemID,cboRoute.Text); Responses.Update('ROUTE',1,cboRoute.ItemID,cboRoute.Text);
tmpSch := UpperCase(Trim(cboSchedule.Text)); tmpSch := UpperCase(Trim(cboSchedule.Text));
@ -1634,12 +1949,10 @@ var
aSchedule: string; aSchedule: string;
begin begin
aSchedule := ''; aSchedule := '';
if not ShowOtherSchedule(aSchedule) then cboSchedule.ItemIndex := -1;
begin cboSchedule.Text := '';
cboSchedule.ItemIndex := -1; cboSchedule.DroppedDown := false;
cboSchedule.Text := ''; if ShowOtherSchedule(aSchedule) then
end
else
begin begin
Result := Piece(aSchedule,U,1); Result := Piece(aSchedule,U,1);
NSSAdminTime := Piece(aschedule,u,2); NSSAdminTime := Piece(aschedule,u,2);
@ -1651,12 +1964,28 @@ procedure TfrmODMedIV.grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer;
State: TGridDrawState); State: TGridDrawState);
begin begin
inherited; inherited;
if Sender = ActiveControl then Exit; //if Sender = ActiveControl then Exit;
if not (gdSelected in State) then Exit; //if not (gdSelected in State) then Exit;
with Sender as TStringGrid do with Sender as TStringGrid do
begin begin
Canvas.Brush.Color := Color; if State = [gdSelected..gdFocused] then
Canvas.Font := Font; begin
Canvas.Font.Color := Get508CompliantColor(clWhite);
Canvas.Brush.Color := clHighlight;
//Canvas.Font.Color := clHighlightText;
Canvas.Font.Style := [fsBold];
Canvas.MoveTo(Rect.Left,Rect.top);
end
else
begin
if (ACol = 4) and (ColWidths[4] > 0) then
Canvas.Brush.Color := clInactiveBorder
else Canvas.Brush.Color := clWindow;
Canvas.Font := Font;
end;
Canvas.FillRect(Rect);
//Canvas.Brush.Color := Color;
Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]); Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
end; end;
end; end;
@ -1697,6 +2026,13 @@ begin
end; end;
end; end;
procedure TfrmODMedIV.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) and (ActiveControl = grdSelected) then
Key := #0; //Don't let the base class turn it into a forward tab!
inherited;
end;
procedure TfrmODMedIV.grdSelectedKeyPress(Sender: TObject; var Key: Char); procedure TfrmODMedIV.grdSelectedKeyPress(Sender: TObject; var Key: Char);
begin begin
inherited; inherited;
@ -1781,6 +2117,12 @@ begin
cboSchedule.ItemIndex := idx; cboSchedule.ItemIndex := idx;
exit; exit;
end; end;
//if PRN schedule than set the checkbox than exit
if (X = ' PRN') or (X = 'PRN') then
begin
chkPRN.Checked := True;
Exit;
end;
//Check to see if schedule is a Day-of-Week Schedule (MO-WE-FR@BID) //Check to see if schedule is a Day-of-Week Schedule (MO-WE-FR@BID)
if (Pos('@', x) > 0) then if (Pos('@', x) > 0) then
begin begin
@ -1804,7 +2146,6 @@ begin
begin begin
//tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5); //tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5);
tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx]; tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx];
cboSchedule.Items.Add(tempSch);
cboSchedule.Text := (Piece(tempSch,U,1)); cboSchedule.Text := (Piece(tempSch,U,1));
cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch, U, 1)); cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch, U, 1));
chkPRN.Checked := True; chkPRN.Checked := True;
@ -1885,6 +2226,13 @@ begin
ControlChange(Sender); ControlChange(Sender);
end; end;
function TfrmODMedIV.UpdateAddFreq(OI: integer): string;
begin
if (self.cboType.ItemIndex = -1) or (MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous') then
Result := GetDefaultAddFreq(OI)
else Result := '';
end;
procedure TfrmODMedIV.UpdateDuration(SchType: string); procedure TfrmODMedIV.UpdateDuration(SchType: string);
begin begin
if SchType = 'O' then if SchType = 'O' then
@ -1908,7 +2256,7 @@ var
AnIVComponent: TIVComponent; AnIVComponent: TIVComponent;
i: integer; i: integer;
OrderIds, TempIVRoute: TStringList; OrderIds, TempIVRoute: TStringList;
Default: boolean; //Default: boolean;
begin begin
if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True; if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True;
TempIVRoute := TStringList.Create; TempIVRoute := TStringList.Create;
@ -1927,19 +2275,21 @@ begin
end; end;
if OrderIds.Count > 0 then if OrderIds.Count > 0 then
begin begin
if (self.FInitialOrderID = True) and (self.grdSelected.RowCount = 1) then Default := True //if (self.FInitialOrderID = True) and (self.grdSelected.RowCount = 1) then Default := True
else Default := False; //else Default := False;
LoadDosageFormIVRoutes(self.cboRoute.Items, OrderIds, Default); LoadDosageFormIVRoutes(self.cboRoute.Items, OrderIds);
if default = True then //if default = True then
// begin
for I := 0 to cboRoute.items.Count - 1 do
begin begin
for I := 0 to cboRoute.items.Count - 1 do if Piece(cboRoute.Items.Strings[i], U, 5) = 'D' then
if Piece(cboRoute.Items.Strings[i], U, 5) = 'D' then begin
begin cboRoute.ItemIndex := i;
cboRoute.ItemIndex := i; break;
break; end;
end;
self.FInitialOrderID := false;
end; end;
// self.FInitialOrderID := false;
//end;
OrderIds.Free; OrderIds.Free;
end; end;
if TempIVRoute.Count > 0 then if TempIVRoute.Count > 0 then
@ -1953,13 +2303,14 @@ end;
procedure TfrmODMedIV.txtAllIVRoutesClick(Sender: TObject); procedure TfrmODMedIV.txtAllIVRoutesClick(Sender: TObject);
var var
i: integer; i: integer;
msg : String;
begin begin
inherited; inherited;
if MessageDlg('You can also select "OTHER" from the Route list' msg := 'You can also select "OTHER" from the Route list'
+ ' to select a Route from the Expanded Med Route List.' + ' to select a Route from the Expanded Med Route List.'
+ #13#10 + 'Click OK to launch the Expanded Med Route List.', + #13#10 + 'Click OK to launch the Expanded Med Route List.';
mtInformation, [mbOK, mbCancel],0) = mrOK then if ShowMsg(msg, smiInfo, smbOKCancel) = smrOk then
begin begin
for I := 0 to cboRoute.Items.Count - 1 do if cboRoute.Items.Strings[i] = U + 'OTHER' then break; for I := 0 to cboRoute.Items.Count - 1 do if cboRoute.Items.Strings[i] = U + 'OTHER' then break;
cboRoute.ItemIndex := i; cboRoute.ItemIndex := i;
@ -1970,13 +2321,14 @@ end;
procedure TfrmODMedIV.txtNSSClick(Sender: TObject); procedure TfrmODMedIV.txtNSSClick(Sender: TObject);
var var
i: integer; i: integer;
msg : String;
begin begin
inherited; inherited;
if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list' msg := 'You can also select ' + '"' + 'Other' + '"' + ' from the schedule list'
+ ' to create a day-of-week schedule.' + ' to create a day-of-week schedule.'
+ #13#10 + 'Click OK to launch schedule builder', + #13#10 + 'Click OK to launch schedule builder';
mtInformation, [mbOK, mbCancel],0) = mrOK then if ShowMsg(msg, smiInfo, smbOKCancel) = smrOK then
begin begin
//cboSchedule.Items.Add(U + 'OTHER'); //cboSchedule.Items.Add(U + 'OTHER');
for I := 0 to cboSchedule.Items.Count - 1 do if cboSchedule.Items.Strings[i] = 'OTHER' then break; for I := 0 to cboSchedule.Items.Count - 1 do if cboSchedule.Items.Strings[i] = 'OTHER' then break;

55
CPRS-Chart/Orders/fODMedNVA.dfm
View File

@ -2,29 +2,29 @@ inherited frmODMedNVA: TfrmODMedNVA
Left = 203 Left = 203
Top = 183 Top = 183
Width = 632 Width = 632
Height = 536 Height = 542
Caption = 'Document Herbal/OTC/Non-VA Medications' Caption = 'Document Herbal/OTC/Non-VA Medications'
Constraints.MinHeight = 365 Constraints.MinHeight = 365
ExplicitWidth = 632 ExplicitWidth = 632
ExplicitHeight = 536 ExplicitHeight = 542
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
inherited memOrder: TCaptionMemo inherited memOrder: TCaptionMemo
Left = 0 Left = 0
Top = 461 Top = 467
Width = 525 Width = 525
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
Constraints.MinWidth = 25 Constraints.MinWidth = 25
TabOrder = 4 TabOrder = 4
ExplicitLeft = 0 ExplicitLeft = 0
ExplicitTop = 461 ExplicitTop = 467
ExplicitWidth = 525 ExplicitWidth = 525
end end
object pnlMeds: TPanel [1] object pnlMeds: TPanel [1]
Left = 6 Left = 6
Top = 34 Top = 34
Width = 593 Width = 593
Height = 415 Height = 421
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone BevelOuter = bvNone
Caption = 'pnlMeds' Caption = 'pnlMeds'
@ -72,7 +72,7 @@ inherited frmODMedNVA: TfrmODMedNVA
Left = 0 Left = 0
Top = 137 Top = 137
Width = 593 Width = 593
Height = 278 Height = 284
Align = alClient Align = alClient
Columns = < Columns = <
item item
@ -98,7 +98,7 @@ inherited frmODMedNVA: TfrmODMedNVA
end end
object txtMed: TEdit [2] object txtMed: TEdit [2]
Left = 5 Left = 5
Top = 6 Top = 12
Width = 596 Width = 596
Height = 21 Height = 21
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
@ -112,9 +112,9 @@ inherited frmODMedNVA: TfrmODMedNVA
end end
object pnlFields: TPanel [3] object pnlFields: TPanel [3]
Left = 3 Left = 3
Top = 30 Top = 43
Width = 624 Width = 624
Height = 428 Height = 423
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone BevelOuter = bvNone
Enabled = False Enabled = False
@ -124,14 +124,14 @@ inherited frmODMedNVA: TfrmODMedNVA
Left = 0 Left = 0
Top = 0 Top = 0
Width = 624 Width = 624
Height = 264 Height = 259
Align = alClient Align = alClient
Constraints.MinHeight = 80 Constraints.MinHeight = 80
Constraints.MinWidth = 30 Constraints.MinWidth = 30
TabOrder = 0 TabOrder = 0
DesignSize = ( DesignSize = (
624 624
264) 259)
object lblRoute: TLabel object lblRoute: TLabel
Left = 349 Left = 349
Top = 23 Top = 23
@ -171,7 +171,7 @@ inherited frmODMedNVA: TfrmODMedNVA
OnClick = lblGuidelineClick OnClick = lblGuidelineClick
end end
object tabDose: TTabControl object tabDose: TTabControl
Left = -7 Left = 1
Top = 19 Top = 19
Width = 175 Width = 175
Height = 17 Height = 17
@ -187,7 +187,7 @@ inherited frmODMedNVA: TfrmODMedNVA
Left = 8 Left = 8
Top = 36 Top = 36
Width = 383 Width = 383
Height = 222 Height = 217
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
Style = orcsSimple Style = orcsSimple
AutoSelect = True AutoSelect = True
@ -209,13 +209,14 @@ inherited frmODMedNVA: TfrmODMedNVA
OnChange = cboDosageChange OnChange = cboDosageChange
OnClick = cboDosageClick OnClick = cboDosageClick
OnExit = cboDosageExit OnExit = cboDosageExit
OnKeyUp = cboDosageKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboRoute: TORComboBox object cboRoute: TORComboBox
Left = 355 Left = 355
Top = 36 Top = 36
Width = 114 Width = 114
Height = 223 Height = 218
Anchors = [akTop, akRight, akBottom] Anchors = [akTop, akRight, akBottom]
Style = orcsSimple Style = orcsSimple
AutoSelect = True AutoSelect = True
@ -237,14 +238,14 @@ inherited frmODMedNVA: TfrmODMedNVA
TabOrder = 2 TabOrder = 2
OnChange = cboRouteChange OnChange = cboRouteChange
OnClick = ControlChange OnClick = ControlChange
OnExit = cboRouteExit OnKeyUp = cboRouteKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object cboSchedule: TORComboBox object cboSchedule: TORComboBox
Left = 467 Left = 467
Top = 36 Top = 37
Width = 157 Width = 157
Height = 223 Height = 218
Anchors = [akTop, akRight, akBottom] Anchors = [akTop, akRight, akBottom]
Style = orcsSimple Style = orcsSimple
AutoSelect = True AutoSelect = True
@ -264,7 +265,7 @@ inherited frmODMedNVA: TfrmODMedNVA
TabOrder = 3 TabOrder = 3
OnChange = cboScheduleChange OnChange = cboScheduleChange
OnClick = cboScheduleClick OnClick = cboScheduleClick
OnExit = cboScheduleExit OnKeyUp = cboScheduleKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object chkPRN: TCheckBox object chkPRN: TCheckBox
@ -282,7 +283,7 @@ inherited frmODMedNVA: TfrmODMedNVA
end end
object pnlBottom: TPanel object pnlBottom: TPanel
Left = 0 Left = 0
Top = 264 Top = 259
Width = 624 Width = 624
Height = 164 Height = 164
Align = alBottom Align = alBottom
@ -387,7 +388,7 @@ inherited frmODMedNVA: TfrmODMedNVA
end end
object btnSelect: TButton [4] object btnSelect: TButton [4]
Left = 539 Left = 539
Top = 463 Top = 469
Width = 72 Width = 72
Height = 21 Height = 21
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
@ -399,23 +400,23 @@ inherited frmODMedNVA: TfrmODMedNVA
end end
inherited cmdAccept: TButton inherited cmdAccept: TButton
Left = 540 Left = 540
Top = 463 Top = 469
Width = 69 Width = 69
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
TabOrder = 6 TabOrder = 6
Visible = False Visible = False
ExplicitLeft = 540 ExplicitLeft = 540
ExplicitTop = 463 ExplicitTop = 469
ExplicitWidth = 69 ExplicitWidth = 69
end end
inherited cmdQuit: TButton inherited cmdQuit: TButton
Left = 546 Left = 546
Top = 489 Top = 495
Width = 49 Width = 49
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
TabOrder = 7 TabOrder = 7
ExplicitLeft = 546 ExplicitLeft = 546
ExplicitTop = 489 ExplicitTop = 495
ExplicitWidth = 49 ExplicitWidth = 49
end end
inherited pnlMessage: TPanel inherited pnlMessage: TPanel
@ -435,7 +436,8 @@ inherited frmODMedNVA: TfrmODMedNVA
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = txtMed' 'Component = txtMed'
'Status = stsDefault') 'Text = Medication'
'Status = stsOK')
( (
'Component = pnlFields' 'Component = pnlFields'
'Status = stsDefault') 'Status = stsDefault')
@ -483,7 +485,8 @@ inherited frmODMedNVA: TfrmODMedNVA
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = memOrder' 'Component = memOrder'
'Status = stsDefault') 'Text = Order Sig'
'Status = stsOK')
( (
'Component = cmdAccept' 'Component = cmdAccept'
'Status = stsDefault') 'Status = stsDefault')

38
CPRS-Chart/Orders/fODMedNVA.pas
View File

@ -62,14 +62,12 @@ type
procedure lstAllData(Sender: TObject; Item: TListItem); procedure lstAllData(Sender: TObject; Item: TListItem);
procedure lblGuidelineClick(Sender: TObject); procedure lblGuidelineClick(Sender: TObject);
procedure ListViewClick(Sender: TObject); procedure ListViewClick(Sender: TObject);
procedure cboScheduleExit(Sender: TObject);
procedure cboScheduleChange(Sender: TObject); procedure cboScheduleChange(Sender: TObject);
procedure cboRouteChange(Sender: TObject); procedure cboRouteChange(Sender: TObject);
procedure ControlChange(Sender: TObject); procedure ControlChange(Sender: TObject);
procedure cboDosageClick(Sender: TObject); procedure cboDosageClick(Sender: TObject);
procedure cboDosageChange(Sender: TObject); procedure cboDosageChange(Sender: TObject);
procedure cboScheduleClick(Sender: TObject); procedure cboScheduleClick(Sender: TObject);
procedure cboRouteExit(Sender: TObject);
procedure DispOrderMessage(const AMessage: string); procedure DispOrderMessage(const AMessage: string);
@ -91,6 +89,11 @@ type
procedure lstChange(Sender: TObject; Item: TListItem; procedure lstChange(Sender: TObject; Item: TListItem;
Change: TItemChange); Change: TItemChange);
procedure FormKeyPress(Sender: TObject; var Key: Char); procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure cboDosageKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private private
{selection} {selection}
@ -379,6 +382,7 @@ begin
LoadOTCStatements(lbStatements.Items); LoadOTCStatements(lbStatements.Items);
FRemoveText := True; FRemoveText := True;
FShrinkDrugMsg := False; FShrinkDrugMsg := False;
if ScreenReaderActive then lstQuick.TabStop := True;
end; end;
procedure TfrmODMedNVA.FormDestroy(Sender: TObject); procedure TfrmODMedNVA.FormDestroy(Sender: TObject);
@ -812,9 +816,12 @@ begin
LoadNonVAMedCache(Item.Index, Item.Index); LoadNonVAMedCache(Item.Index, Item.Index);
chunk := GetCacheChunkIndex(Item.Index); chunk := GetCacheChunkIndex(Item.Index);
list := TStringList(FNVAMedCache[chunk]); list := TStringList(FNVAMedCache[chunk]);
x := list[Item.Index mod MED_CACHE_CHUNK_SIZE]; //This is to make sure that the index that is being used is not outside of the stringlist
Item.Caption := Piece(x, U, 2); If Item.Index mod MED_CACHE_CHUNK_SIZE < list.Count then begin
Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0)); x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
Item.Caption := Piece(x, U, 2);
Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
end;
end; end;
procedure TfrmODMedNVA.lstAllDataHint(Sender: TObject; StartIndex, procedure TfrmODMedNVA.lstAllDataHint(Sender: TObject; StartIndex,
@ -1137,7 +1144,7 @@ begin
btnSelect.Anchors := [akRight, akTop]; btnSelect.Anchors := [akRight, akTop];
btnSelect.Default := False; btnSelect.Default := False;
cmdAccept.Visible := True; cmdAccept.Visible := True;
cmdAccept.Default := True; cmdAccept.Default := False;
btnSelect.TabOrder := txtMed.TabOrder + 1; btnSelect.TabOrder := txtMed.TabOrder + 1;
cmdAccept.TabStop := True; cmdAccept.TabStop := True;
txtMed.Width := memOrder.Width; txtMed.Width := memOrder.Width;
@ -1390,6 +1397,13 @@ begin
end; end;
end; end;
procedure TfrmODMedNVA.cboDosageKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboDosage.Text = '') then cboDosage.ItemIndex := -1;
end;
{ cboRoute -------------------------------------- } { cboRoute -------------------------------------- }
procedure TfrmODMedNVA.cboRouteChange(Sender: TObject); procedure TfrmODMedNVA.cboRouteChange(Sender: TObject);
@ -1406,9 +1420,13 @@ begin
if Sender <> Self then ControlChange(Sender); if Sender <> Self then ControlChange(Sender);
end; end;
procedure TfrmODMedNVA.cboRouteExit(Sender: TObject);
procedure TfrmODMedNVA.cboRouteKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin begin
inherited; inherited;
if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1;
end; end;
{ cboSchedule ----------------------------------- } { cboSchedule ----------------------------------- }
@ -1425,8 +1443,12 @@ begin
UpdateRelated; UpdateRelated;
end; end;
procedure TfrmODMedNVA.cboScheduleExit(Sender: TObject);
procedure TfrmODMedNVA.cboScheduleKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin begin
inherited;
if (Key = VK_BACK) and (cboSchedule.Text = '') then cboSchedule.ItemIndex := -1;
end; end;
{ values changing } { values changing }

82
CPRS-Chart/Orders/fODMeds.dfm
View File

@ -2,24 +2,24 @@ inherited frmODMeds: TfrmODMeds
Left = 321 Left = 321
Top = 183 Top = 183
Width = 584 Width = 584
Height = 572 Height = 578
HorzScrollBar.Range = 558 AutoScroll = True
VertScrollBar.Range = 399
Caption = 'Medication Order' Caption = 'Medication Order'
Constraints.MinHeight = 325 Constraints.MinHeight = 325
Constraints.MinWidth = 452
OnShow = FormShow OnShow = FormShow
ExplicitWidth = 584 ExplicitWidth = 584
ExplicitHeight = 572 ExplicitHeight = 578
DesignSize = ( DesignSize = (
576 576
545) 544)
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pnlMeds: TPanel [0] object pnlMeds: TPanel [0]
Left = 6 Left = 6
Top = 34 Top = 34
Width = 580 Width = 580
Height = 470 Height = 476
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
@ -67,7 +67,7 @@ inherited frmODMeds: TfrmODMeds
Left = 0 Left = 0
Top = 137 Top = 137
Width = 580 Width = 580
Height = 333 Height = 339
Align = alClient Align = alClient
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
@ -98,17 +98,16 @@ inherited frmODMeds: TfrmODMeds
end end
inherited memOrder: TCaptionMemo inherited memOrder: TCaptionMemo
Tag = 13 Tag = 13
Top = 505 Top = 511
Width = 502 Width = 502
TabStop = True
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
TabOrder = 4 TabOrder = 4
ExplicitTop = 505 ExplicitTop = 511
ExplicitWidth = 502 ExplicitWidth = 502
end end
object txtMed: TEdit [2] object txtMed: TEdit [2]
Left = 6 Left = 6
Top = 6 Top = 12
Width = 580 Width = 580
Height = 21 Height = 21
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
@ -122,7 +121,7 @@ inherited frmODMeds: TfrmODMeds
end end
object btnSelect: TButton [3] object btnSelect: TButton [3]
Left = 515 Left = 515
Top = 505 Top = 511
Width = 72 Width = 72
Height = 21 Height = 21
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
@ -134,9 +133,9 @@ inherited frmODMeds: TfrmODMeds
end end
object pnlFields: TPanel [4] object pnlFields: TPanel [4]
Left = 6 Left = 6
Top = 34 Top = 44
Width = 580 Width = 580
Height = 470 Height = 465
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone BevelOuter = bvNone
Enabled = False Enabled = False
@ -147,13 +146,13 @@ inherited frmODMeds: TfrmODMeds
Left = 0 Left = 0
Top = 0 Top = 0
Width = 580 Width = 580
Height = 197 Height = 192
Align = alClient Align = alClient
Constraints.MinHeight = 80 Constraints.MinHeight = 80
TabOrder = 3 TabOrder = 3
DesignSize = ( DesignSize = (
580 580
197) 192)
object lblRoute: TLabel object lblRoute: TLabel
Left = 280 Left = 280
Top = 23 Top = 23
@ -194,7 +193,7 @@ inherited frmODMeds: TfrmODMeds
Left = 0 Left = 0
Top = 36 Top = 36
Width = 580 Width = 580
Height = 156 Height = 151
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
ColCount = 7 ColCount = 7
DefaultColWidth = 76 DefaultColWidth = 76
@ -258,7 +257,7 @@ inherited frmODMeds: TfrmODMeds
Left = 1 Left = 1
Top = 36 Top = 36
Width = 279 Width = 279
Height = 155 Height = 150
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
Style = orcsSimple Style = orcsSimple
AutoSelect = True AutoSelect = True
@ -288,7 +287,7 @@ inherited frmODMeds: TfrmODMeds
Left = 280 Left = 280
Top = 36 Top = 36
Width = 113 Width = 113
Height = 156 Height = 151
Anchors = [akTop, akRight, akBottom] Anchors = [akTop, akRight, akBottom]
Style = orcsSimple Style = orcsSimple
AutoSelect = True AutoSelect = True
@ -311,6 +310,7 @@ inherited frmODMeds: TfrmODMeds
OnChange = cboRouteChange OnChange = cboRouteChange
OnClick = ControlChange OnClick = ControlChange
OnExit = cboRouteExit OnExit = cboRouteExit
OnKeyUp = cboRouteKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
UniqueAutoComplete = True UniqueAutoComplete = True
end end
@ -318,7 +318,7 @@ inherited frmODMeds: TfrmODMeds
Left = 394 Left = 394
Top = 36 Top = 36
Width = 178 Width = 178
Height = 156 Height = 151
Anchors = [akTop, akRight, akBottom] Anchors = [akTop, akRight, akBottom]
Style = orcsSimple Style = orcsSimple
AutoSelect = False AutoSelect = False
@ -340,6 +340,7 @@ inherited frmODMeds: TfrmODMeds
OnClick = cboScheduleClick OnClick = cboScheduleClick
OnEnter = cboScheduleEnter OnEnter = cboScheduleEnter
OnExit = cboScheduleExit OnExit = cboScheduleExit
OnKeyUp = cboScheduleKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
UniqueAutoComplete = True UniqueAutoComplete = True
end end
@ -472,6 +473,7 @@ inherited frmODMeds: TfrmODMeds
TabOrder = 2 TabOrder = 2
TabStop = True TabStop = True
OnClick = btnXDurationClick OnClick = btnXDurationClick
OnEnter = pnlXDurationButtonEnter
object btnXDuration: TSpeedButton object btnXDuration: TSpeedButton
Left = 0 Left = 0
Top = 0 Top = 0
@ -557,6 +559,7 @@ inherited frmODMeds: TfrmODMeds
OnEnter = cboXScheduleEnter OnEnter = cboXScheduleEnter
OnExit = cboXScheduleExit OnExit = cboXScheduleExit
OnKeyDown = memMessageKeyDown OnKeyDown = memMessageKeyDown
OnKeyUp = cboXScheduleKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
UniqueAutoComplete = True UniqueAutoComplete = True
end end
@ -574,7 +577,7 @@ inherited frmODMeds: TfrmODMeds
end end
object pnlBottom: TPanel object pnlBottom: TPanel
Left = 0 Left = 0
Top = 197 Top = 192
Width = 580 Width = 580
Height = 273 Height = 273
Align = alBottom Align = alBottom
@ -599,7 +602,7 @@ inherited frmODMeds: TfrmODMeds
Caption = 'Days Supply' Caption = 'Days Supply'
end end
object lblQuantity: TLabel object lblQuantity: TLabel
Left = 84 Left = 81
Top = 65 Top = 65
Width = 39 Width = 39
Height = 13 Height = 13
@ -608,14 +611,14 @@ inherited frmODMeds: TfrmODMeds
ShowHint = True ShowHint = True
end end
object lblRefills: TLabel object lblRefills: TLabel
Left = 164 Left = 140
Top = 65 Top = 65
Width = 28 Width = 28
Height = 13 Height = 13
Caption = 'Refills' Caption = 'Refills'
end end
object lblPriority: TLabel object lblPriority: TLabel
Left = 500 Left = 503
Top = 61 Top = 61
Width = 31 Width = 31
Height = 13 Height = 13
@ -681,9 +684,9 @@ inherited frmODMeds: TfrmODMeds
TabOrder = 2 TabOrder = 2
end end
object txtQuantity: TCaptionEdit object txtQuantity: TCaptionEdit
Left = 83 Left = 80
Top = 78 Top = 78
Width = 60 Width = 40
Height = 21 Height = 21
AutoSize = False AutoSize = False
TabOrder = 3 TabOrder = 3
@ -693,7 +696,7 @@ inherited frmODMeds: TfrmODMeds
Caption = 'Quantity' Caption = 'Quantity'
end end
object spnQuantity: TUpDown object spnQuantity: TUpDown
Left = 143 Left = 120
Top = 78 Top = 78
Width = 16 Width = 16
Height = 21 Height = 21
@ -702,7 +705,7 @@ inherited frmODMeds: TfrmODMeds
TabOrder = 4 TabOrder = 4
end end
object txtRefills: TCaptionEdit object txtRefills: TCaptionEdit
Left = 164 Left = 140
Top = 78 Top = 78
Width = 30 Width = 30
Height = 21 Height = 21
@ -714,7 +717,7 @@ inherited frmODMeds: TfrmODMeds
Caption = 'Refills' Caption = 'Refills'
end end
object spnRefills: TUpDown object spnRefills: TUpDown
Left = 194 Left = 170
Top = 78 Top = 78
Width = 15 Width = 15
Height = 21 Height = 21
@ -723,11 +726,10 @@ inherited frmODMeds: TfrmODMeds
TabOrder = 6 TabOrder = 6
end end
object grpPickup: TGroupBox object grpPickup: TGroupBox
Left = 283 Left = 188
Top = 66 Top = 66
Width = 172 Width = 172
Height = 36 Height = 36
Anchors = [akTop, akRight]
Caption = 'Pick Up' Caption = 'Pick Up'
TabOrder = 7 TabOrder = 7
object radPickWindow: TRadioButton object radPickWindow: TRadioButton
@ -759,7 +761,7 @@ inherited frmODMeds: TfrmODMeds
end end
end end
object cboPriority: TORComboBox object cboPriority: TORComboBox
Left = 499 Left = 502
Top = 76 Top = 76
Width = 72 Width = 72
Height = 21 Height = 21
@ -781,6 +783,7 @@ inherited frmODMeds: TfrmODMeds
SynonymChars = '<>' SynonymChars = '<>'
TabOrder = 9 TabOrder = 9
OnChange = ControlChange OnChange = ControlChange
OnKeyUp = cboPriorityKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
object stcPI: TStaticText object stcPI: TStaticText
@ -884,27 +887,28 @@ inherited frmODMeds: TfrmODMeds
OnEnter = cboXSequenceEnter OnEnter = cboXSequenceEnter
OnExit = cboXSequenceExit OnExit = cboXSequenceExit
OnKeyDown = memMessageKeyDown OnKeyDown = memMessageKeyDown
OnKeyUp = cboXSequenceKeyUp
CharsNeedMatch = 1 CharsNeedMatch = 1
end end
end end
inherited cmdAccept: TButton inherited cmdAccept: TButton
Left = 514 Left = 514
Top = 505 Top = 511
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
TabOrder = 6 TabOrder = 6
TabStop = False TabStop = False
Visible = False Visible = False
ExplicitLeft = 514 ExplicitLeft = 514
ExplicitTop = 505 ExplicitTop = 511
end end
inherited cmdQuit: TButton inherited cmdQuit: TButton
Left = 514 Left = 514
Top = 530 Top = 536
Width = 51 Width = 51
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
TabOrder = 7 TabOrder = 7
ExplicitLeft = 514 ExplicitLeft = 514
ExplicitTop = 530 ExplicitTop = 536
ExplicitWidth = 51 ExplicitWidth = 51
end end
inherited pnlMessage: TPanel inherited pnlMessage: TPanel
@ -1063,7 +1067,8 @@ inherited frmODMeds: TfrmODMeds
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = memOrder' 'Component = memOrder'
'Status = stsDefault') 'Text = Order Sig'
'Status = stsOK')
( (
'Component = cmdAccept' 'Component = cmdAccept'
'Status = stsDefault') 'Status = stsDefault')
@ -1084,7 +1089,8 @@ inherited frmODMeds: TfrmODMeds
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = lblAdminSch' 'Component = lblAdminSch'
'Status = stsDefault') 'Text = Admin Schedule.'
'Status = stsOK')
( (
'Component = lblAdminTime' 'Component = lblAdminTime'
'Status = stsDefault')) 'Status = stsDefault'))

380
CPRS-Chart/Orders/fODMeds.pas
View File

@ -188,6 +188,17 @@ type
procedure cboXSequenceExit(Sender: TObject); procedure cboXSequenceExit(Sender: TObject);
procedure cboXSequenceEnter(Sender: TObject); procedure cboXSequenceEnter(Sender: TObject);
procedure txtRefillsChange(Sender: TObject); procedure txtRefillsChange(Sender: TObject);
procedure QuantityMessageCheck(Tag: integer) ;
procedure pnlXDurationButtonEnter(Sender: TObject);
procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboXScheduleKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboXSequenceKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cboPriorityKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
//procedure btnNSSClick(Sender: TObject); //procedure btnNSSClick(Sender: TObject);
private private
FCloseCalled : Boolean; FCloseCalled : Boolean;
@ -288,7 +299,7 @@ type
procedure UpdateStartExpires(const CurSchedule: string); procedure UpdateStartExpires(const CurSchedule: string);
procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean); var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean);
procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct: string;
var CurSupply: Integer; var CurQuantity: double); var CurSupply: Integer; var CurQuantity: double);
procedure UpdateDurationControls( FreeText: boolean); procedure UpdateDurationControls( FreeText: boolean);
function DisableDefaultButton(Control: TWinControl): boolean; function DisableDefaultButton(Control: TWinControl): boolean;
@ -396,6 +407,7 @@ const
FLD_NOW_NM = 76; FLD_NOW_NM = 76;
FLD_COMMENT = 80; FLD_COMMENT = 80;
FLD_PTINSTR = 85; FLD_PTINSTR = 85;
FLD_DRUG_ID_INT = 90;
{dosage type tab index values} {dosage type tab index values}
TI_DOSE = 0; TI_DOSE = 0;
TI_RATE = 99; TI_RATE = 99;
@ -541,6 +553,10 @@ begin
x := 'IVM RX'; x := 'IVM RX';
end; end;
if self.EvtID > 0 then FAdminTimeText := 'To Be Determined'; if self.EvtID > 0 then FAdminTimeText := 'To Be Determined';
if (isIMO = True) then self.Caption := 'Clinic Orders Medications'
else if FInptDlg = True then self.Caption := 'Inpatient Medications'
else if DlgFormID = OD_MEDOUTPT then self.Caption := 'Outpatient Medications'
else self.Caption := 'Medications Orders';
ListForOrderable(FCacheIEN, ListCount, x); ListForOrderable(FCacheIEN, ListCount, x);
lstAll.Items.Count := ListCount; lstAll.Items.Count := ListCount;
FMedCache := TObjectList.Create; FMedCache := TObjectList.Create;
@ -613,8 +629,8 @@ end;
procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string); procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
var var
AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime: string; AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime, x: string;
ix: integer; i, ix: integer;
LocChange: boolean; LocChange: boolean;
AResponse: TResponse; AResponse: TResponse;
@ -630,7 +646,7 @@ begin
end; end;
//AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true //AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true
//this is not the best approach but this should fix the problem with order edit losing the quantity value. //this is not the best approach but this should fix the problem with order edit losing the quantity value.
if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then if ((OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY)) then
begin begin
FIsQuickOrder := True; FIsQuickOrder := True;
FQOInitial := True; FQOInitial := True;
@ -646,6 +662,17 @@ begin
begin begin
Changing := True; Changing := True;
txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0); txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
if OrderAction = ORDER_QUICK then
begin
if DEACheckFailed(txtMed.Tag, FInptDlg) then
begin
//btnSelect.Visible := False;
btnSelect.Enabled := False;
InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
AbortOrder := True;
Exit;
end;
end;
if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
(uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit; (uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit;
if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
@ -671,7 +698,7 @@ begin
nsSch := TResponse(Responses.theList[ix]).EVALUE; nsSch := TResponse(Responses.theList[ix]).EVALUE;
if length(nsSch) > 0 then if length(nsSch) > 0 then
begin begin
SetSchedule(nsSch); SetSchedule(UpperCase(nsSch));
{cboSchedule.SelectByID(nsSch); {cboSchedule.SelectByID(nsSch);
if cboSchedule.ItemIndex < 0 then if cboSchedule.ItemIndex < 0 then
begin begin
@ -693,13 +720,13 @@ begin
begin begin
AResponse := Responses.FindResponseByName('ADMIN', 1); AResponse := Responses.FindResponseByName('ADMIN', 1);
if AResponse <> nil then AdminTime := AResponse.EValue; if AResponse <> nil then AdminTime := AResponse.EValue;
if self.cboSchedule.ItemIndex > -1 then if (self.cboSchedule.ItemIndex > -1) and (AdminTime <> '') then
begin begin
tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex]; tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
SetPiece(tempSchString,U,4,AdminTime); SetPiece(tempSchString,U,4,AdminTime);
self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString; self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
end; end;
if self.tabDose.TabIndex = TI_COMPLEX then if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) and (AdminTime <> '') then
begin begin
if self.cboXSchedule.ItemIndex > -1 then if self.cboXSchedule.ItemIndex > -1 then
begin begin
@ -721,7 +748,7 @@ begin
self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString; self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
end; end;
end; end;
if self.tabDose.TabIndex = TI_COMPLEX then if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) then
begin begin
if self.cboXSchedule.ItemIndex > -1 then if self.cboXSchedule.ItemIndex > -1 then
begin begin
@ -741,7 +768,29 @@ begin
if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText); if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText);
end; end;
if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or
(XfInToOutNow = true) or (FIsQuickOrder) then UpdateRelated(FALSE); //AGP Change (XfInToOutNow = true) or (FIsQuickOrder) then
begin
UpdateRelated(FALSE); //AGP Change
//Need to do the following code to reset the FLastUnits and FLastSchedule in case a free text Dose is found. If the following
//code is not done than the quantity will reset to zero
if not FInptDlg then
begin
FLastUnits := '';
FLastSchedule := '';
FLastInstruct := '';
//Lasti := Responses.InstanceCount('INSTR');
//Lasti := Responses.NextInstance('DOSE', 0);
for I := 1 to Responses.InstanceCount('INSTR') do
begin
x := ValueOfResponse(FLD_DOSEUNIT, i);
FLastUnits := FLastUnits + x + U;
x := Responses.IValueFor('INSTR', i);
FLastInstruct := FLastInstruct + x + U;
x := ValueOfResponse(FLD_SCHEDULE, i);
FLastSchedule := FLastSchedule + x + U;
end;
end;
end;
Changing := False; Changing := False;
if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and
(self.cboSchedule.ItemIndex > -1) then (self.cboSchedule.ItemIndex > -1) then
@ -761,6 +810,7 @@ begin
Caption := Text; Caption := Text;
memComment.Clear; // sometimes the sig is in the comment memComment.Clear; // sometimes the sig is in the comment
end; end;
FQOInitial := False;
ControlChange(Self); ControlChange(Self);
if Self.IsSupply then if Self.IsSupply then
btnSelect.Enabled := False; btnSelect.Enabled := False;
@ -817,12 +867,21 @@ var
ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance); ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance);
ADrug := ValueOfResponse(FLD_DRUG_ID, AnInstance); ADrug := ValueOfResponse(FLD_DRUG_ID, AnInstance);
tmpX := x; //Changed for CQ: 7370 - it was tmpX := Trim(x); tmpX := x; //Changed for CQ: 7370 - it was tmpX := Trim(x);
if Pos(CRLF, tmpX)> 0 then
begin
SetError('Schedule cannot contains control characters');
Exit;
end;
if (Length(tmpX) = 0) and (not FInptDlg) then SetError(TX_NO_SCHED) if (Length(tmpX) = 0) and (not FInptDlg) then SetError(TX_NO_SCHED)
else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug) else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
then SetError(TX_NO_SCHED); then SetError(TX_NO_SCHED);
if Length(tmpX) > 0 then if Length(tmpX) > 0 then
begin begin
if FInptDlg then ValidLevel := ValidSchedule(tmpX) else ValidLevel := ValidSchedule(tmpX, 'O'); if FInptDlg then ValidLevel := ValidSchedule(tmpX) else ValidLevel := ValidSchedule(tmpX, 'O');
(* if FInptDlg and (tmpX <> '') and (cboSchedule.ItemIndex = -1) and
(self.tabDose.TabIndex = TI_DOSE) then
//SetError('Unique Schedule Selection Required');
SetError('More than one schedule starts with "'+tmpX+'". Please select a schedule from the list.'); *)
if ValidLevel = SCH_NO_RTN then if ValidLevel = SCH_NO_RTN then
begin begin
if Pos('"', tmpX) > 0 then SetError(TX_SCH_QUOTE); if Pos('"', tmpX) > 0 then SetError(TX_SCH_QUOTE);
@ -856,8 +915,15 @@ begin
end; end;
if Length(Responses.IValueFor('INSTR', i)) > 60 then if Length(Responses.IValueFor('INSTR', i)) > 60 then
begin begin
SetError(TX_DOSE_LEN); if self.tabDose.TabIndex = TI_COMPLEX then
cboDosage.SetFocus; //CQ: 7467 begin
SetError('Dosage: ' + Responses.IValueFor('INSTR', i) + CRLF + TX_DOSE_LEN);
end
else
begin
SetError(TX_DOSE_LEN);
cboDosage.SetFocus; //CQ: 7467
end;
end; end;
end; end;
ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i); ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
@ -888,6 +954,14 @@ begin
SetError(TX_NO_SEQ); SetError(TX_NO_SEQ);
Exit; Exit;
end; end;
if Uppercase(ValFor(Col_Sequence, i)) = 'THEN' then
begin
if ValFor(Col_Duration,i) = '' then
begin
SetError('A duration is required when using "Then" as a sequence.');
Exit;
end;
end;
end; end;
end; end;
if not FInptDlg then // outpatient stuff if not FInptDlg then // outpatient stuff
@ -1317,9 +1391,12 @@ begin
LoadMedCache(Item.Index, Item.Index); LoadMedCache(Item.Index, Item.Index);
chunk := GetCacheChunkIndex(Item.Index); chunk := GetCacheChunkIndex(Item.Index);
list := TStringList(FMedCache[chunk]); list := TStringList(FMedCache[chunk]);
x := list[Item.Index mod MED_CACHE_CHUNK_SIZE]; //This is to make sure that the index that is being used is not outside of the stringlist
Item.Caption := Piece(x, U, 2); If Item.Index mod MED_CACHE_CHUNK_SIZE < list.Count then begin
Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0)); x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
Item.Caption := Piece(x, U, 2);
Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
end;
end; end;
procedure TfrmODMeds.lstAllDataHint(Sender: TObject; StartIndex, procedure TfrmODMeds.lstAllDataHint(Sender: TObject; StartIndex,
@ -1414,7 +1491,6 @@ begin
end; end;
end; *) end; *)
FAltChecked := True; FAltChecked := True;
;
SetOnMedSelect; // set up for this medication SetOnMedSelect; // set up for this medication
SetOnQuickOrder; // insert quick order responses SetOnQuickOrder; // insert quick order responses
if Length(txtQuantity.Text)>0 then if Length(txtQuantity.Text)>0 then
@ -1423,6 +1499,7 @@ begin
if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false; if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false;
if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then
txtQuantity.Text := QOQuantityStr; txtQuantity.Text := QOQuantityStr;
//FQOInitial := False;
end end
else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then // orderable item else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then // orderable item
begin begin
@ -1452,8 +1529,9 @@ begin
if Pos(' NF', self.MedName) > 0 then if Pos(' NF', self.MedName) > 0 then
begin begin
temp := self.MedName; temp := self.MedName;
CheckFormularyOI(MedIEN, temp, FInptDlg); CheckFormularyOI(medIEN, temp, FInptDlg);
FAltChecked := True; FAltChecked := True;
txtMed.Text := '';
end; end;
if MedIEN <> txtMed.Tag then if MedIEN <> txtMed.Tag then
begin begin
@ -1480,6 +1558,8 @@ begin
end end
else ShowMedSelect; // show the selection fields else ShowMedSelect; // show the selection fields
FNoZERO := False; FNoZERO := False;
if FQOInitial = True then FQOInitial := False;
end; end;
procedure TfrmODMeds.ResetOnMedChange; procedure TfrmODMeds.ResetOnMedChange;
@ -1584,7 +1664,7 @@ begin
LoadOrderItem(OIForMed(txtMed.Tag, FInptDlg, IncludeOIPI, PKIEnviron)); LoadOrderItem(OIForMed(txtMed.Tag, FInptDlg, IncludeOIPI, PKIEnviron));
// set up lists & initial values based on orderable item // set up lists & initial values based on orderable item
SetControl(txtMed, 'Medication'); SetControl(txtMed, 'Medication');
if (self.MedName <> '') then if (self.MedName <> '') then
begin begin
if (txtMed.Text <> self.MedName) then if (txtMed.Text <> self.MedName) then
begin begin
@ -1602,7 +1682,7 @@ begin
//AGP Change 27.72 trying to centralized the schedule setting code //AGP Change 27.72 trying to centralized the schedule setting code
AResponse := Responses.FindResponseByName('SCHEDULE',1); AResponse := Responses.FindResponseByName('SCHEDULE',1);
if (AResponse <> nil) and (AResponse.EValue <> '') then x := AResponse.EValue; if (AResponse <> nil) and (AResponse.EValue <> '') then x := AResponse.EValue;
SetSchedule(x); SetSchedule(UpperCase(x));
(* if x <> '' then (* if x <> '' then
begin begin
cboSchedule.SelectByID(x); cboSchedule.SelectByID(x);
@ -1715,7 +1795,7 @@ end;
procedure TfrmODMeds.SetOnQuickOrder; procedure TfrmODMeds.SetOnQuickOrder;
var var
AResponse: TResponse; AResponse: TResponse;
x,LocRoute,TempSch,DispGrp: string; x,LocRoute,TempSch,DispGrp, SchType: string;
i, DispDrug: Integer; i, DispDrug: Integer;
begin begin
// txtMed already set by SetOnMedSelect // txtMed already set by SetOnMedSelect
@ -1729,20 +1809,16 @@ begin
begin begin
SetDosage(IValueFor('INSTR', i)); SetDosage(IValueFor('INSTR', i));
with cboDosage do with cboDosage do
if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] //agp change QO code to populate the Grid with the same fields after selection CQ 15933
//if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex]
if ItemIndex > -1 then x := Piece(Text, TAB, 1) + TAB + Items[ItemIndex]
else x := IValueFor('INSTR',i); //AGP Change 26.41 for CQ 9102 PSI-05-015 affect copy and edit functionality else x := IValueFor('INSTR',i); //AGP Change 26.41 for CQ 9102 PSI-05-015 affect copy and edit functionality
grdDoses.Cells[COL_DOSAGE, i] := x; grdDoses.Cells[COL_DOSAGE, i] := x;
SetControl(cboRoute, 'ROUTE', i); SetControl(cboRoute, 'ROUTE', i);
with cboRoute do with cboRoute do
if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text; if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
grdDoses.Cells[COL_ROUTE, i] := x; grdDoses.Cells[COL_ROUTE, i] := x;
if FIsQuickOrder then TempSch := cboSchedule.Text; SetSchedule(UpperCase(IValueFor('SCHEDULE', i)));
SetSchedule(IValueFor('SCHEDULE', i));
if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
begin
cboSchedule.SelectByID(TempSch);
cboSchedule.Text := TempSch;
end;
if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1; if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
x := cboSchedule.Text; x := cboSchedule.Text;
if chkPRN.Checked then x := x + ' PRN'; if chkPRN.Checked then x := x + ' PRN';
@ -1754,12 +1830,22 @@ begin
if FInptDlg then if FInptDlg then
begin begin
if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i) if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i)
else if cboSchedule.ItemIndex > -1 then else if (cboSchedule.ItemIndex > -1) and (chkPRN.Checked = false) then
grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4) grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4)
else grdDoses.Cells[COL_ADMINTIME, i] := ''; else grdDoses.Cells[COL_ADMINTIME, i] := '';
if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined'; if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined';
if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText; if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText;
//done to prevent admin time showing up in schedules that should not have admin times. Also remove Not Defined for schedule
//should not show the admin time
if (cboSchedule.ItemIndex > -1) or (chkPRN.Checked = True) then
begin
SchType := '';
if (cboSchedule.ItemIndex > -1) then SchType := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,3);
if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') or (ChkPRN.Checked = True) then
grdDoses.Cells[COL_ADMINTIME, i] := '';
end;
end; end;
chkPRN.Checked := false;
if IValueFor('CONJ', i) = 'A' then x := 'AND' if IValueFor('CONJ', i) = 'A' then x := 'AND'
else if IValueFor('CONJ', i) = 'T' then x := 'THEN' else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT' else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT'
@ -1778,7 +1864,7 @@ begin
else else
SetDosage(IValueFor('INSTR', 1)); SetDosage(IValueFor('INSTR', 1));
SetControl(cboRoute, 'ROUTE', 1); SetControl(cboRoute, 'ROUTE', 1);
SetSchedule(IValueFor('SCHEDULE', 1)); SetSchedule(UpperCase(IValueFor('SCHEDULE', 1)));
if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
begin begin
cboSchedule.SelectByID(TempSch); cboSchedule.SelectByID(TempSch);
@ -1844,7 +1930,7 @@ begin
Responses.FindResponseByName('SC', 1); Responses.FindResponseByName('SC', 1);
end; {if FInptDlg..else} end; {if FInptDlg..else}
end; {with} end; {with}
if FInptDlg then if (FInptDlg) then
begin begin
x := ValueOfResponse(FLD_SCHEDULE, 1); x := ValueOfResponse(FLD_SCHEDULE, 1);
if Length(x) > 0 then UpdateStartExpires(x); if Length(x) > 0 then UpdateStartExpires(x);
@ -1900,7 +1986,7 @@ begin
btnSelect.Anchors := [akRight, akTop]; btnSelect.Anchors := [akRight, akTop];
btnSelect.Default := False; btnSelect.Default := False;
cmdAccept.Visible := True; cmdAccept.Visible := True;
cmdAccept.Default := True; cmdAccept.Default := False;
cmdAccept.Left := cmdQuit.Left; cmdAccept.Left := cmdQuit.Left;
cmdAccept.Top := MemOrder.Top; cmdAccept.Top := MemOrder.Top;
btnSelect.TabOrder := txtMed.TabOrder + 1; btnSelect.TabOrder := txtMed.TabOrder + 1;
@ -1995,6 +2081,7 @@ procedure TfrmODMeds.ShowControlsComplex;
//dosagetxt: string; //dosagetxt: string;
begin begin
tabDose.TabIndex := TI_COMPLEX; tabDose.TabIndex := TI_COMPLEX;
lblAdminSchSetTexT('');
MoveCombo(cboDosage, cboXDosage); MoveCombo(cboDosage, cboXDosage);
MoveCombo(cboRoute, cboXRoute); MoveCombo(cboRoute, cboXRoute);
MoveCombo(cboSchedule, cboXSchedule, true); //AGP Changes 26.12 PSI-04-063 MoveCombo(cboSchedule, cboXSchedule, true); //AGP Changes 26.12 PSI-04-063
@ -2078,9 +2165,15 @@ begin
end; end;
end; end;
cboSchedule.ItemIndex := -1; cboSchedule.ItemIndex := -1;
cboSchedule.Text := '';
if chkPRN.Checked = True then chkPRN.Checked := False; if chkPRN.Checked = True then chkPRN.Checked := False;
cboSchedule.SelectByID(x); cboSchedule.SelectByID(x);
if cboSchedule.ItemIndex > -1 then exit; if cboSchedule.ItemIndex > -1 then exit;
if (X = ' PRN') or (X = 'PRN') then
begin
chkPRN.Checked := True;
Exit;
end;
// if cboSchedule.ItemIndex < 0 then // if cboSchedule.ItemIndex < 0 then
//begin //begin
//if NSSchedule then //if NSSchedule then
@ -2432,6 +2525,13 @@ begin
inherited; inherited;
end; end;
procedure TfrmODMeds.cboRouteKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1;
end;
{ cboSchedule ----------------------------------- } { cboSchedule ----------------------------------- }
procedure TfrmODMeds.cboScheduleClick(Sender: TObject); procedure TfrmODMeds.cboScheduleClick(Sender: TObject);
@ -2471,8 +2571,9 @@ begin
othSch := CreateOtherScheduel; othSch := CreateOtherScheduel;
if length(trim(othSch)) > 1 then if length(trim(othSch)) > 1 then
begin begin
othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
cboSchedule.Items.Add(othSch); cboSchedule.Items.Add(othSch);
idx := cboSchedule.Items.IndexOf(OthSch); idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
cboSchedule.ItemIndex := idx; cboSchedule.ItemIndex := idx;
end; end;
end; end;
@ -2527,6 +2628,29 @@ begin
ControlChange(Sender); ControlChange(Sender);
end; end;
procedure TfrmODMeds.QuantityMessageCheck(tag: integer);
var
DispDrug: integer;
x: string;
begin
if FInptDlg then Exit;
DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID, tag), 0);
if DispDrug > 0 then
begin
if not FSuppressMsg then
begin
DispOrderMessage(DispenseMessage(DispDrug));
FSuppressMsg := False;
end;
x := QuantityMessage(DispDrug);
end
else x := '';
if Length(x) > 0
then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
else lblQtyMsg.Caption := '';
end;
{ txtSupply, txtQuantity -------------------------- } { txtSupply, txtQuantity -------------------------- }
procedure TfrmODMeds.txtSupplyChange(Sender: TObject); procedure TfrmODMeds.txtSupplyChange(Sender: TObject);
@ -2741,7 +2865,9 @@ begin
DoseDrug := DoseDrug + U + FDrugID; DoseDrug := DoseDrug + U + FDrugID;
for i := 0 to Pred(FAllDoses.Count) do for i := 0 to Pred(FAllDoses.Count) do
begin begin
if AnsiSameText(DoseDrug, Copy(FAllDoses[i], 1, Length(DoseDrug))) then // CQ #16957 - Corrected code that would potentially mis-match drugs - JCS
//if AnsiSameText(DoseDrug, Copy(FAllDoses[i], 1, Length(DoseDrug))) then
if AnsiSameText(DoseDrug, Pieces(FAllDoses[i],U,1,2)) then
begin begin
Result := Piece(FAllDoses[i], U, 3); Result := Piece(FAllDoses[i], U, 3);
Break; Break;
@ -3141,7 +3267,7 @@ begin
DoseMinutes := 0; DoseMinutes := 0;
if Piece(x, ' ', 2) = 'MONTHS' then DoseMinutes := ExtractInteger(x) * 43200; if Piece(x, ' ', 2) = 'MONTHS' then DoseMinutes := ExtractInteger(x) * 43200;
if Piece(x, ' ', 2) = 'WEEKS' then DoseMinutes := ExtractInteger(x) * 10080; if Piece(x, ' ', 2) = 'WEEKS' then DoseMinutes := ExtractInteger(x) * 10080;
if Piece(x, ' ', 2) = 'DAYS' then DoseMinutes := ExtractInteger(x) * 1440; if Pos('DAY',Piece(x, ' ', 2))>0 then DoseMinutes := ExtractInteger(x) * 1440;
if Piece(x, ' ', 2) = 'HOURS' then DoseMinutes := ExtractInteger(x) * 60; if Piece(x, ' ', 2) = 'HOURS' then DoseMinutes := ExtractInteger(x) * 60;
if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x); if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x);
// Determine how TotalMinutes should be calculated based on conjunction // Determine how TotalMinutes should be calculated based on conjunction
@ -3181,7 +3307,7 @@ begin
inherited; inherited;
with grdDoses do with grdDoses do
begin begin
i := grdDoses.Width - 12; // 12 = 4 pixel margin + 8 pixel column 0 i := grdDoses.Width - 20; // 20 = 12 pixel margin + 8 pixel column 0
i := i - GetSystemMetrics(SM_CXVSCROLL); // compensate for appearance of scroll bar i := i - GetSystemMetrics(SM_CXVSCROLL); // compensate for appearance of scroll bar
if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then
begin begin
@ -3463,6 +3589,7 @@ begin
if grdDoses.Row = Pred(grdDoses.RowCount) then grdDoses.RowCount := grdDoses.RowCount + 1; if grdDoses.Row = Pred(grdDoses.RowCount) then grdDoses.RowCount := grdDoses.RowCount + 1;
DisableDefaultButton(self); DisableDefaultButton(self);
DisableCancelButton(self); DisableCancelButton(self);
QuantityMessageCheck(cboXDosage.Tag);
end; end;
procedure TfrmODMeds.cboXDosageChange(Sender: TObject); procedure TfrmODMeds.cboXDosageChange(Sender: TObject);
@ -3731,6 +3858,12 @@ begin
infoBox(str,'Administration Time Information',MB_OK); infoBox(str,'Administration Time Information',MB_OK);
end; end;
procedure TfrmODMeds.pnlXDurationButtonEnter(Sender: TObject);
begin
inherited;
QuantityMessageCheck(self.grdDoses.Row);
end;
procedure TfrmODMeds.pnlXDurationEnter(Sender: TObject); procedure TfrmODMeds.pnlXDurationEnter(Sender: TObject);
begin begin
inherited; inherited;
@ -4073,7 +4206,7 @@ begin
FLD_SUPPLY : Result := Trim(txtSupply.Text); FLD_SUPPLY : Result := Trim(txtSupply.Text);
FLD_QUANTITY : FLD_QUANTITY :
begin begin
if Pos(',', txtQuantity.Text)>0 then if Pos(',', txtQuantity.Text)>0 then
Result := Piece(txtQuantity.Text,',',1) + Piece(txtQuantity.Text,',',2) Result := Piece(txtQuantity.Text,',',1) + Piece(txtQuantity.Text,',',2)
else else
Result := Trim(txtQuantity.Text); Result := Trim(txtQuantity.Text);
@ -4128,7 +4261,7 @@ var
tmpSupply: integer; tmpSupply: integer;
begin begin
Checked := false; Checked := false;
if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and
(txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> '')) (txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> ''))
or ((cboDosage.ItemIndex < 0) and (not FIsQuickOrder)) or or ((cboDosage.ItemIndex < 0) and (not FIsQuickOrder)) or
((IsClozapineOrder = true) and (FISQuickOrder) and (FQOInitial)) then ((IsClozapineOrder = true) and (FISQuickOrder) and (FQOInitial)) then
@ -4136,7 +4269,7 @@ begin
Checked := True; Checked := True;
ADrug := Piece(CurDispDrug, U, 1); ADrug := Piece(CurDispDrug, U, 1);
CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule); CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
if CurSupply > 0 then if CurSupply > 0 then
begin begin
spnSupply.Position := CurSupply; spnSupply.Position := CurSupply;
if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then
@ -4159,7 +4292,7 @@ begin
end; end;
SkipQtyCheck := TRUE; SkipQtyCheck := TRUE;
end; end;
if FQOInitial = true then FQOInitial := False; //if FQOInitial = true then FQOInitial := False;
end; end;
if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then
begin begin
@ -4184,7 +4317,9 @@ begin
end; end;
end; end;
procedure TfrmODMeds.UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; //add CURInstrcut to this procedure. This address a problem with an user starting with a free-text dosage and changing
//to another free-text dose and the quantity value not updating.
procedure TfrmODMeds.UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct: string;
var CurSupply: Integer; var CurQuantity: double); var CurSupply: Integer; var CurQuantity: double);
const const
UPD_NONE = 0; UPD_NONE = 0;
@ -4196,9 +4331,8 @@ var
UpdateControl, NewSupply: Integer; UpdateControl, NewSupply: Integer;
ADrug: string; ADrug: string;
SaveChanging: Boolean; SaveChanging: Boolean;
tmpQuty: Double; tmpQuantity: double;
begin begin
tmpQuty := 0;
if (tabDose.TabIndex = TI_COMPLEX) and (txtSupply.Tag = 0) and (txtQuantity.Tag = 0) then if (tabDose.TabIndex = TI_COMPLEX) and (txtSupply.Tag = 0) and (txtQuantity.Tag = 0) then
begin begin
// set days supply based on durations // set days supply based on durations
@ -4219,7 +4353,8 @@ begin
(CurSchedule = FLastSchedule) and (CurSchedule = FLastSchedule) and
(CurDuration = FLastDuration) and (CurDuration = FLastDuration) and
(CurQuantity = FLastQuantity) and (CurQuantity = FLastQuantity) and
(CurSupply = FLastSupply) then Exit; (CurSupply = FLastSupply) and
(CurInstruct = FLastInstruct) then Exit;
// exit if supply & quantity have both been directly edited // exit if supply & quantity have both been directly edited
if (txtSupply.Tag > 0) and (txtQuantity.Tag > 0) then Exit; if (txtSupply.Tag > 0) and (txtQuantity.Tag > 0) then Exit;
// figure out which control to update // figure out which control to update
@ -4228,7 +4363,7 @@ begin
if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) and (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) and Changing then UpdateControl := UPD_BOTH if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) and (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) and Changing then UpdateControl := UPD_BOTH
else if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) then UpdateControl := UPD_QUANTITY else if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) then UpdateControl := UPD_QUANTITY
else if (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) then UpdateControl := UPD_SUPPLY; else if (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) then UpdateControl := UPD_SUPPLY;
if (UpdateControl = UPD_NONE) and ((CurUnits <> FLastUnits) or (CurSchedule <> FLastSchedule)) then if (UpdateControl = UPD_NONE) and (((CurUnits <> FLastUnits) or (CurInstruct <> FLastInstruct)) or (CurSchedule <> FLastSchedule)) then
begin begin
if txtQuantity.Tag = 0 then UpdateControl := UPD_QUANTITY if txtQuantity.Tag = 0 then UpdateControl := UPD_QUANTITY
else if txtSupply.Tag = 0 then UpdateControl := UPD_SUPPLY; else if txtSupply.Tag = 0 then UpdateControl := UPD_SUPPLY;
@ -4238,17 +4373,11 @@ begin
UPD_QUANTITY : begin UPD_QUANTITY : begin
if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
begin begin
FQOInitial := False; txtQuantity.Text := FloatToStr(CurQuantity);
Exit; Exit;
end; end;
if FIsQuickOrder and (CurQuantity > 0) then
tmpQuty := CurQuantity;
CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug); CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
if (tmpQuty > 0) and (CurQuantity <= 0) then if (CurQuantity >= 0) then
begin
txtQuantity.Text := FloatToStr(tmpQuty);
CurQuantity := tmpQuty;
end else if (CurQuantity >= 0) then
txtQuantity.Text := FloatToStr(CurQuantity); txtQuantity.Text := FloatToStr(CurQuantity);
end; end;
UPD_SUPPLY : begin UPD_SUPPLY : begin
@ -4257,20 +4386,21 @@ begin
end; end;
UPD_BOTH : begin UPD_BOTH : begin
txtSupply.Text := IntToStr(CurSupply); txtSupply.Text := IntToStr(CurSupply);
tmpQuty := 0; spnSupply.Position := StrToIntDef(txtSupply.Text, 0);
tmpQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
begin
txtQuantity.Text := FloatToStr(CurQuantity);
Exit;
end;
(* if FIsQuickOrder and (CurQuantity > 0) and (tmpQuantity = 0) and FQOInitial then
begin begin
FQOInitial := False; txtQuantity.Text := FloatToStr(CurQuantity);
Exit; Exit;
end; end; *)
if FIsQuickOrder and (CurQuantity > 0) then //CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
tmpQuty := CurQuantity; CurQuantity := tmpQuantity;
CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug); if CurQuantity >= 0 then
if (tmpQuty > 0) and (CurQuantity <= 0) then
begin
txtQuantity.Text := FloatToStr(tmpQuty);
CurQuantity := tmpQuty;
end else if CurQuantity >= 0 then
txtQuantity.Text := FloatToStr(CurQuantity); txtQuantity.Text := FloatToStr(CurQuantity);
end; end;
end; end;
@ -4578,31 +4708,15 @@ begin
if lblAdminTime.Visible then if lblAdminTime.Visible then
lblAdminTime.Caption := ''; lblAdminTime.Caption := '';
end; end;
if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then UpdateStartExpires(CurSchedule); if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then
//AGP remove this code for CQ 11772 UpdateStartExpires(CurSchedule);
(*if (ValueOf(FLD_SCHED_TYP) = 'O')
or (Responses.EventType in ['A','D','T','M','O'])
or ((Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0)) then
begin
if (chkDoseNow.Checked) and (chkDoseNow.Visible) then
begin
chkDoseNowClick(Self);
chkDoseNow.Checked := False;
end;
chkDoseNow.Visible := False;
lblAdminTime.Visible := False;
end
else
begin
chkDoseNow.Visible := TRUE;
lblAdminTime.Visible := not chkDoseNow.Checked;
end; *)
if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False; if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
end; end;
if not FInptDlg then if not FInptDlg then
begin begin
CurSchedule := CurScheduleOut; CurSchedule := CurScheduleOut;
if ((CurInstruct <> FLastInstruct) and (CurUnits <> U)) or ((IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server if ((CurInstruct <> FLastInstruct) and (CurUnits <> U)) or ((IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server
//if ((CurInstruct <> FLastInstruct) and (CurUnits <> U))
then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity, then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity,
LackQtyInfo); LackQtyInfo);
if LackQtyInfo then begin if LackQtyInfo then begin
@ -4610,7 +4724,7 @@ begin
txtQuantity.Text := '0'; txtQuantity.Text := '0';
end end
else else
UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity); UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct, CurSupply, CurQuantity);
// if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug); // if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);
if ((CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0)) then if ((CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0)) then
UpdateRefills(CurDispDrug, CurSupply); UpdateRefills(CurDispDrug, CurSupply);
@ -4632,6 +4746,7 @@ begin
Changing := SaveChanging; Changing := SaveChanging;
if FUpdated then ControlChange(Self); if FUpdated then ControlChange(Self);
FScheduleChanged := false; FScheduleChanged := false;
//FQOInitial := False;
end; end;
procedure TfrmODMeds.cmdAcceptClick(Sender: TObject); procedure TfrmODMeds.cmdAcceptClick(Sender: TObject);
@ -4643,6 +4758,7 @@ begin
cboScheduleClick(Self); cboScheduleClick(Self);
Exit; Exit;
end; end;
if timCheckChanges.Enabled = True then sleep(1500);
//AGP Change for 26.45 PSI-04-069 //AGP Change for 26.45 PSI-04-069
if self.tabDose.TabIndex = 1 then if self.tabDose.TabIndex = 1 then
begin begin
@ -4689,24 +4805,28 @@ procedure TfrmODMeds.chkDoseNowClick(Sender: TObject);
const const
T = '"'; T = '"';
T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication "'; T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication "';
T2 = #13#13'The first order''s administrative schedule is "'; T2 = #13#13'The "Give additional dose now" order has an administration schedule of "';
T3 = #13'The second order''s administrative schedule is "'; T3 = #13'The "Ongoing" order has an administration schedule of "';
T4 = #13#13'Do you want to continue?'; T4 = #13#13'Do you want to continue?';
T5 = '" and a priority of "';
T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"'; T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"';
T2A = ' in addition to the one you are placing for the same medication "'; T2A = ' in addition to the one you are placing for the same medication "';
var var
medNm: string; medNm: string;
theSch: string; theSch: string;
ordPriority: string;
begin begin
inherited; inherited;
if (chkDoseNow.Checked) and (tabDose.TabIndex <> TI_COMPLEX) then if (chkDoseNow.Checked) and (tabDose.TabIndex <> TI_COMPLEX) then
begin begin
medNm := txtMed.Text; medNm := txtMed.Text;
theSch := cboSchedule.Text; theSch := cboSchedule.Text;
ordPriority := cboPriority.SelText;
if length(theSch)>0 then if length(theSch)>0 then
begin begin
//if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then //if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then
if InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then //if InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
if InfoBox(T1+medNm+T+T2+'NOW'+T5+ordPriority+T+T3+theSch+T5+ordPriority+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
begin begin
chkDoseNow.Checked := False; chkDoseNow.Checked := False;
Exit; Exit;
@ -4831,7 +4951,7 @@ begin
begin begin
lblAdminTime.Caption := ''; lblAdminTime.Caption := '';
PrnPos := Pos('PRN',cboSchedule.Text); PrnPos := Pos('PRN',cboSchedule.Text);
if (PrnPos < 1) then if (PrnPos < 1) and (FQOInitial = false) then
UpdateStartExpires(cboSchedule.Text + ' PRN'); UpdateStartExpires(cboSchedule.Text + ' PRN');
end end
else else
@ -4839,12 +4959,14 @@ begin
if Length(Trim(cboSchedule.Text))>0 then if Length(Trim(cboSchedule.Text))>0 then
begin begin
tempSch := ';'+Trim(cboSchedule.Text); tempSch := ';'+Trim(cboSchedule.Text);
UpdateStartExpires(tempSch); if FQOInitial = false then UpdateStartExpires(tempSch);
end; end;
//lblAdminTime.Caption := FAdminTimeLbl; //lblAdminTime.Caption := FAdminTimeLbl;
if txtQuantity.visible then if txtQuantity.visible then
cboScheduleClick(Self); cboScheduleClick(Self);
end; end;
if FQOInitial = false then updateRelated(False);
//updateRelated(False);
ControlChange(Self); ControlChange(Self);
end; end;
@ -4964,14 +5086,12 @@ end;
procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char); procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char);
begin begin
(* if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then if (Key = #13) and (ActiveControl = txtMed) then
begin Key := #0 //Don't let the base class turn it into a forward tab!
ShowEditor(grdDoses.Col, grdDoses.Row, #0); else if (Key = #13) and (self.tabDose.TabIndex = TI_Complex) then
Key := #0; //Don't let the base class turn it into a forward tab! Key := #0
end *) else
//else inherited;
if (Key = #13) and (ActiveControl = txtMed) then
Key := #0; //Don't let the base class turn it into a forward tab!
end; end;
procedure TfrmODMeds.FormKeyDown(Sender: TObject; var Key: Word; procedure TfrmODMeds.FormKeyDown(Sender: TObject; var Key: Word;
@ -4992,6 +5112,7 @@ begin
inherited; inherited;
DisableDefaultButton(self); DisableDefaultButton(self);
DisableCancelButton(self); DisableCancelButton(self);
QuantityMessageCheck(self.grdDoses.Row);
end; end;
procedure TfrmODMeds.pnlMessageEnter(Sender: TObject); procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);
@ -5040,6 +5161,19 @@ begin
pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8; pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8;
tempAdmin := lblAdminSchGetText; tempAdmin := lblAdminSchGetText;
if tempAdmin <> '' then lblAdminSchSetText('Admin Time: ' + tempAdmin); if tempAdmin <> '' then lblAdminSchSetText('Admin Time: ' + tempAdmin);
if not (FInptDLG) then
begin
if self.cboPriority.Left < (self.grpPickup.Left + self.grpPickup.Width) then
begin
self.cboPriority.Left := self.grpPickup.Left + self.grpPickup.Width + 2;
if self.Width < (self.cboPriority.Left + self.cboPriority.Width) then
begin
self.Width := self.cboPriority.Left + self.cboPriority.Width + 9;
self.cboPriority.Left := self.pnlBottom.Width - self.cboPriority.Width - 2;
end;
self.lblPriority.Left := self.cboPriority.Left;
end;
end;
end; end;
procedure TfrmODMeds.memPIKeyDown(Sender: TObject; var Key: Word; procedure TfrmODMeds.memPIKeyDown(Sender: TObject; var Key: Word;
@ -5133,9 +5267,16 @@ var
begin begin
result := False; result := False;
IsInptDlg := False; IsInptDlg := False;
Td := FMToday; // CQ #15188 - changed to use function to determine Td value - TDP
//Td := FMToday;
Td := IMOTimeFrame;
if DlgFormID = MedsInDlgFormId then IsInptDlg := TRUE; if DlgFormID = MedsInDlgFormId then IsInptDlg := TRUE;
IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN); IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN);
// CQ #15188 - allow IMO functionality 23 hours after encounter date/time - JCS
// CQ #15188 - changed to use function to set Td. Reverted this line back to original - TDP
{if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and
(Encounter.DateTime > DateTimeToFMDateTime(FMDateTimeToDateTime(FMNow) - (23/24))) then}
if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then
result := True; result := True;
end; end;
@ -5270,6 +5411,15 @@ begin
if Trim(cboSchedule.Text) = '' then if Trim(cboSchedule.Text) = '' then
cboSchedule.ItemIndex := -1; cboSchedule.ItemIndex := -1;
ValidateInpatientSchedule(cboSchedule); ValidateInpatientSchedule(cboSchedule);
updateRelated(False);
end;
procedure TfrmODMeds.cboScheduleKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboSchedule.Text = '') then cboSchedule.itemindex:= -1;
end; end;
procedure TfrmODMeds.ValidateInpatientSchedule(ScheduleCombo: TORComboBox); procedure TfrmODMeds.ValidateInpatientSchedule(ScheduleCombo: TORComboBox);
@ -5284,7 +5434,7 @@ begin
if (Length(ScheduleCombo.Text) > 0) then if (Length(ScheduleCombo.Text) > 0) then
ScheduleCombo.Text := TrimLeft(UpperCase(ScheduleCombo.Text)); ScheduleCombo.Text := TrimLeft(UpperCase(ScheduleCombo.Text));
{if user entered schedule verify it is in list} {if user entered schedule verify it is in list}
if ScheduleCombo.ItemIndex < 0 then // CQ: 7397 if (ScheduleCombo.ItemIndex < 0) and (not FInptDlg) then // CQ: 7397 and CQ 17934
begin //Fix for CQ: 9299 - Outpatient Med orders will not accept free text schedule begin //Fix for CQ: 9299 - Outpatient Med orders will not accept free text schedule
tmpIndex := GetSchedListIndex(ScheduleCombo,ScheduleCombo.Text); tmpIndex := GetSchedListIndex(ScheduleCombo,ScheduleCombo.Text);
if tmpIndex > -1 then if tmpIndex > -1 then
@ -5297,10 +5447,12 @@ begin
'If you would like to create a Day-of-Week schedule please'+ 'If you would like to create a Day-of-Week schedule please'+
' select ''OTHER'' from the list.', ' select ''OTHER'' from the list.',
'Incorrect Schedule.'); 'Incorrect Schedule.');
ScheduleCombo.ItemIndex := -1;
ScheduleCombo.Text := '';
FShowPnlXScheduleOk := True; //Added for CQ: 7370 FShowPnlXScheduleOk := True; //Added for CQ: 7370
if ScheduleCombo.CanFocus then if ScheduleCombo.CanFocus then
ScheduleCombo.SetFocus; ScheduleCombo.SetFocus;
ScheduleCombo.SelStart := Length(ScheduleCombo.Text); //ScheduleCombo.SelStart := Length(ScheduleCombo.Text);
end; end;
end; end;
@ -5370,6 +5522,14 @@ begin
ValidateInpatientSchedule(cboXSchedule); ValidateInpatientSchedule(cboXSchedule);
end; end;
procedure TfrmODMeds.cboXScheduleKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboXSchedule.Text = '') then cboXSchedule.ItemIndex := -1;
end;
procedure TfrmODMeds.cboXSequenceChange(Sender: TObject); procedure TfrmODMeds.cboXSequenceChange(Sender: TObject);
var var
x: string; x: string;
@ -5395,6 +5555,7 @@ begin
inherited; inherited;
DisableDefaultButton(self); DisableDefaultButton(self);
DisableCancelButton(self); DisableCancelButton(self);
QuantityMessageCheck(self.grdDoses.Row);
end; end;
procedure TfrmODMeds.cboXSequenceExit(Sender: TObject); procedure TfrmODMeds.cboXSequenceExit(Sender: TObject);
@ -5426,6 +5587,14 @@ begin
//UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row)); //UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
end; end;
procedure TfrmODMeds.cboXSequenceKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboXSequence.Text = '') then cboXSequence.ItemIndex := -1;
end;
procedure TfrmODMeds.cboXSequence1Exit(Sender: TObject); procedure TfrmODMeds.cboXSequence1Exit(Sender: TObject);
begin begin
inherited; inherited;
@ -5436,6 +5605,7 @@ procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
begin begin
inherited; inherited;
if (Key = VK_BACK) and (cboDosage.Text = '') then cboDosage.ItemIndex := -1;
//Fix for CQ: 7545 //Fix for CQ: 7545
if cboDosage.ItemIndex > -1 then if cboDosage.ItemIndex > -1 then
cboDosageClick(Sender) cboDosageClick(Sender)
@ -5443,10 +5613,19 @@ begin
UpdateRelated; UpdateRelated;
end; end;
procedure TfrmODMeds.cboPriorityKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboPriority.Text = '') then cboPriority.ItemIndex := -1;
end;
procedure TfrmODMeds.cboXDosageKeyUp(Sender: TObject; var Key: Word; procedure TfrmODMeds.cboXDosageKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
begin begin
inherited; inherited;
if (Key = VK_BACK) and (cboXDosage.Text = '') then cboXDosage.itemindex := -1;
//Fix for CQ: 7545 //Fix for CQ: 7545
if cboXDosage.ItemIndex > -1 then if cboXDosage.ItemIndex > -1 then
cboXDosageClick(Sender) cboXDosageClick(Sender)
@ -5505,6 +5684,7 @@ begin
inherited; inherited;
//agp Change CQ 10719 //agp Change CQ 10719
self.chkXPRN.OnClick(self.chkXPRN); self.chkXPRN.OnClick(self.chkXPRN);
QuantityMessageCheck(self.grdDoses.Row);
end; end;

26
CPRS-Chart/Orders/fODMisc.dfm
View File

@ -33,24 +33,26 @@ inherited frmODMisc: TfrmODMisc
Caption = 'Instructions' Caption = 'Instructions'
end end
inherited memOrder: TCaptionMemo inherited memOrder: TCaptionMemo
TabOrder = 6 TabStop = False
end
inherited cmdAccept: TButton
TabOrder = 4
end
inherited cmdQuit: TButton
TabOrder = 5 TabOrder = 5
end end
inherited pnlMessage: TPanel inherited cmdAccept: TButton
TabOrder = 6
end
inherited cmdQuit: TButton
TabOrder = 7 TabOrder = 7
end end
inherited pnlMessage: TPanel
TabOrder = 1
end
object cboCare: TORComboBox [8] object cboCare: TORComboBox [8]
Left = 6 Left = 8
Top = 20 Top = 25
Width = 292 Width = 292
Height = 21 Height = 21
Style = orcsDropDown Style = orcsDropDown
AutoSelect = True AutoSelect = True
Caption = 'Patient Care'
Color = clWindow Color = clWindow
DropDownCount = 8 DropDownCount = 8
ItemHeight = 13 ItemHeight = 13
@ -74,7 +76,7 @@ inherited frmODMisc: TfrmODMisc
Top = 114 Top = 114
Width = 140 Width = 140
Height = 21 Height = 21
TabOrder = 2 TabOrder = 3
Text = 'Now' Text = 'Now'
OnChange = ControlChange OnChange = ControlChange
DateOnly = False DateOnly = False
@ -86,7 +88,7 @@ inherited frmODMisc: TfrmODMisc
Top = 114 Top = 114
Width = 140 Width = 140
Height = 21 Height = 21
TabOrder = 3 TabOrder = 4
OnChange = ControlChange OnChange = ControlChange
DateOnly = False DateOnly = False
RequireTime = False RequireTime = False
@ -97,7 +99,7 @@ inherited frmODMisc: TfrmODMisc
Top = 67 Top = 67
Width = 508 Width = 508
Height = 21 Height = 21
TabOrder = 1 TabOrder = 2
OnChange = ControlChange OnChange = ControlChange
Caption = 'Instructions' Caption = 'Instructions'
end end

5
CPRS-Chart/Orders/fODMisc.pas
View File

@ -5,7 +5,7 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst, fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst,
VA508AccessibilityManager; VA508AccessibilityManager, VA508AccessibilityRouter;
type type
TfrmODMisc = class(TfrmODBase) TfrmODMisc = class(TfrmODBase)
@ -55,6 +55,7 @@ begin
//CtrlInits.LoadDefaults(ODForMisc); // there are no defaults for OR GXMISC //CtrlInits.LoadDefaults(ODForMisc); // there are no defaults for OR GXMISC
InitDialog; InitDialog;
StatusText(''); StatusText('');
if ScreenReaderSystemActive then memOrder.TabStop := true;
end; end;
procedure TfrmODMisc.InitDialog; procedure TfrmODMisc.InitDialog;
@ -76,7 +77,7 @@ begin
SetControl(calStop, 'STOP', 1); SetControl(calStop, 'STOP', 1);
Changing := False; Changing := False;
ControlChange(Self); ControlChange(Self);
SetFocusedControl(txtComment); if not ScreenReaderSystemActive then SetFocusedControl(txtComment);
end; end;
end; end;

76
CPRS-Chart/Orders/fODRad.dfm
View File

@ -7,8 +7,6 @@ inherited frmODRad: TfrmODRad
Caption = 'Order an Imaging Procedure' Caption = 'Order an Imaging Procedure'
Constraints.MinHeight = 404 Constraints.MinHeight = 404
Constraints.MinWidth = 586 Constraints.MinWidth = 586
ExplicitLeft = 282
ExplicitTop = 225
ExplicitWidth = 586 ExplicitWidth = 586
ExplicitHeight = 404 ExplicitHeight = 404
PixelsPerInch = 96 PixelsPerInch = 96
@ -18,7 +16,7 @@ inherited frmODRad: TfrmODRad
Top = 326 Top = 326
Width = 490 Width = 490
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
TabOrder = 6 TabOrder = 4
ExplicitLeft = 0 ExplicitLeft = 0
ExplicitTop = 326 ExplicitTop = 326
ExplicitWidth = 490 ExplicitWidth = 490
@ -31,7 +29,7 @@ inherited frmODRad: TfrmODRad
ItemHeight = 13 ItemHeight = 13
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 7 TabOrder = 3
Visible = False Visible = False
ItemTipColor = clWindow ItemTipColor = clWindow
LongList = False LongList = False
@ -172,19 +170,11 @@ inherited frmODRad: TfrmODRad
Width = 102 Width = 102
Height = 18 Height = 18
Caption = 'Remove' Caption = 'Remove'
TabOrder = 4 TabOrder = 5
OnClick = cmdRemoveClick OnClick = cmdRemoveClick
end end
end end
inherited cmdAccept: TButton object pnlRightBase: TORAutoPanel [3]
Left = 497
Top = 326
Anchors = [akRight, akBottom]
TabOrder = 3
ExplicitLeft = 497
ExplicitTop = 326
end
object pnlRightBase: TORAutoPanel [4]
Left = 215 Left = 215
Top = 0 Top = 0
Width = 362 Width = 362
@ -232,7 +222,7 @@ inherited frmODRad: TfrmODRad
end end
object lblSubmit: TLabel object lblSubmit: TLabel
Left = 154 Left = 154
Top = 42 Top = 45
Width = 48 Width = 48
Height = 13 Height = 13
Caption = 'Submit To' Caption = 'Submit To'
@ -263,7 +253,7 @@ inherited frmODRad: TfrmODRad
Top = 170 Top = 170
Width = 96 Width = 96
Height = 21 Height = 21
TabOrder = 8 TabOrder = 9
OnChange = calPreOpChange OnChange = calPreOpChange
OnExit = calPreOpExit OnExit = calPreOpExit
DateOnly = False DateOnly = False
@ -279,7 +269,7 @@ inherited frmODRad: TfrmODRad
Caption = 'Isolation' Caption = 'Isolation'
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 6 TabOrder = 7
OnClick = ControlChange OnClick = ControlChange
OnExit = chkIsolationExit OnExit = chkIsolationExit
end end
@ -372,7 +362,7 @@ inherited frmODRad: TfrmODRad
Width = 61 Width = 61
Height = 17 Height = 17
Caption = 'Pre-Op' Caption = 'Pre-Op'
TabOrder = 9 TabOrder = 13
Visible = False Visible = False
OnClick = ControlChange OnClick = ControlChange
end end
@ -411,7 +401,7 @@ inherited frmODRad: TfrmODRad
MultiSelect = True MultiSelect = True
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
TabOrder = 5 TabOrder = 6
Caption = 'Exams Over the Last 7 Days' Caption = 'Exams Over the Last 7 Days'
ItemTipColor = clWindow ItemTipColor = clWindow
LongList = False LongList = False
@ -423,7 +413,7 @@ inherited frmODRad: TfrmODRad
Width = 158 Width = 158
Height = 41 Height = 41
Caption = 'Pregnant' Caption = 'Pregnant'
TabOrder = 7 TabOrder = 8
object radPregnant: TRadioButton object radPregnant: TRadioButton
Left = 2 Left = 2
Top = 17 Top = 17
@ -452,6 +442,19 @@ inherited frmODRad: TfrmODRad
OnClick = ControlChange OnClick = ControlChange
end end
end end
object Submitlbl508: TVA508StaticText
Name = 'Submitlbl508'
Left = 154
Top = 43
Width = 120
Height = 15
Alignment = taLeftJustify
Caption = 'Submit To (for screen R.)'
Enabled = False
TabOrder = 5
Visible = False
ShowAccelChar = True
end
end end
object pnlHandR: TPanel object pnlHandR: TPanel
Left = 0 Left = 0
@ -504,11 +507,19 @@ inherited frmODRad: TfrmODRad
end end
end end
end end
inherited cmdAccept: TButton
Left = 497
Top = 326
Anchors = [akRight, akBottom]
TabOrder = 5
ExplicitLeft = 497
ExplicitTop = 326
end
inherited cmdQuit: TButton inherited cmdQuit: TButton
Left = 498 Left = 498
Top = 353 Top = 353
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
TabOrder = 4 TabOrder = 6
ExplicitLeft = 498 ExplicitLeft = 498
ExplicitTop = 353 ExplicitTop = 353
end end
@ -518,6 +529,7 @@ inherited frmODRad: TfrmODRad
Width = 408 Width = 408
Height = 55 Height = 55
TabOrder = 2 TabOrder = 2
OnMouseUp = pnlMessageMouseUp
ExplicitLeft = 5 ExplicitLeft = 5
ExplicitTop = 318 ExplicitTop = 318
ExplicitWidth = 408 ExplicitWidth = 408
@ -595,7 +607,8 @@ inherited frmODRad: TfrmODRad
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = grpPregnant' 'Component = grpPregnant'
'Status = stsDefault') 'Text = Pregnant group box. Disabled. Patient is male.'
'Status = stsOK')
( (
'Component = radPregnant' 'Component = radPregnant'
'Status = stsDefault') 'Status = stsDefault')
@ -613,7 +626,10 @@ inherited frmODRad: TfrmODRad
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = txtReason' 'Component = txtReason'
'Status = stsDefault')
'Text = Reason for Study REQUIRED text 64 characters maximum leng' +
'th'
'Status = stsOK')
( (
'Component = memOrder' 'Component = memOrder'
'Status = stsDefault') 'Status = stsDefault')
@ -631,6 +647,20 @@ inherited frmODRad: TfrmODRad
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = frmODRad' 'Component = frmODRad'
'Status = stsDefault')
(
'Component = Submitlbl508'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object VA508ComponentAccessibility1: TVA508ComponentAccessibility
Component = memHistory
OnStateQuery = VA508ComponentAccessibility1StateQuery
Left = 336
Top = 64
end
object VA508ComponentAccessibility2: TVA508ComponentAccessibility
Component = grpPregnant
Left = 536
Top = 224
end
end end

74
CPRS-Chart/Orders/fODRad.pas
View File

@ -5,7 +5,7 @@ interface
uses uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls, Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls,
ComCtrls, uConst, ORDtTm, VA508AccessibilityManager; ComCtrls, uConst, ORDtTm, VA508AccessibilityManager, VA508AccessibilityRouter;
type type
TfrmODRad = class(TfrmODBase) TfrmODRad = class(TfrmODBase)
@ -48,6 +48,9 @@ type
lblReason: TLabel; lblReason: TLabel;
txtReason: TCaptionEdit; txtReason: TCaptionEdit;
pnlRightBase: TORAutoPanel; pnlRightBase: TORAutoPanel;
Submitlbl508: TVA508StaticText;
VA508ComponentAccessibility1: TVA508ComponentAccessibility;
VA508ComponentAccessibility2: TVA508ComponentAccessibility;
procedure cboProcedureNeedData(Sender: TObject; procedure cboProcedureNeedData(Sender: TObject;
const StartFrom: string; Direction, InsertAt: Integer); const StartFrom: string; Direction, InsertAt: Integer);
procedure cboAvailModMouseClick(Sender: TObject); procedure cboAvailModMouseClick(Sender: TObject);
@ -70,6 +73,11 @@ type
procedure chkIsolationExit(Sender: TObject); procedure chkIsolationExit(Sender: TObject);
procedure calPreOpExit(Sender: TObject); procedure calPreOpExit(Sender: TObject);
procedure cboImTypeDropDownClose(Sender: TObject); procedure cboImTypeDropDownClose(Sender: TObject);
procedure pnlMessageExit(Sender: TObject);
procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
var Text: string);
procedure pnlMessageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private private
FLastRadID: string; FLastRadID: string;
FEditCopy: boolean; FEditCopy: boolean;
@ -81,6 +89,7 @@ type
function NoPregnantSelection : Boolean; function NoPregnantSelection : Boolean;
procedure ImageTypeChange; procedure ImageTypeChange;
procedure FormFirstOpened(Sender: TObject); procedure FormFirstOpened(Sender: TObject);
procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
protected protected
procedure InitDialog; override; procedure InitDialog; override;
procedure Validate(var AnErrMsg: string); override; procedure Validate(var AnErrMsg: string); override;
@ -220,6 +229,7 @@ procedure TfrmODRad.InitDialog;
var var
i: integer; i: integer;
tmplst: TStringList; tmplst: TStringList;
cboSubmitText: String;
begin begin
if not FEditCopy then if not FEditCopy then
begin begin
@ -265,6 +275,10 @@ begin
cboSubmit.ItemIndex := -1; cboSubmit.ItemIndex := -1;
lblSubmit.Enabled := False; lblSubmit.Enabled := False;
cboSubmit.Enabled := False; cboSubmit.Enabled := False;
//TDP - CQ#19393 cboSubmit 508 changes
cboSubmitText := cboSubmit.Text;
if cboSubmitText = '' then cboSubmitText := 'No Value';
setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
cboSubmit.Font.Color := clGrayText; cboSubmit.Font.Color := clGrayText;
end end
else if (lblAskSubmit.Caption = 'YES') then else if (lblAskSubmit.Caption = 'YES') then
@ -282,6 +296,10 @@ begin
cboSubmit.ItemIndex := -1 ; cboSubmit.ItemIndex := -1 ;
lblSubmit.Enabled := True; lblSubmit.Enabled := True;
cboSubmit.Enabled := True; cboSubmit.Enabled := True;
//TDP - CQ#19393 cboSubmit 508 changes
cboSubmitText := cboSubmit.Text;
if cboSubmitText = '' then cboSubmitText := 'No Value';
setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
cboSubmit.Font.Color := clWindowText; cboSubmit.Font.Color := clWindowText;
end end
else else
@ -289,6 +307,10 @@ begin
cboSubmit.ItemIndex := 0; cboSubmit.ItemIndex := 0;
lblSubmit.Enabled := False; lblSubmit.Enabled := False;
cboSubmit.Enabled := False; cboSubmit.Enabled := False;
//TDP - CQ#19393 cboSubmit 508 changes
cboSubmitText := cboSubmit.Text;
if cboSubmitText = '' then cboSubmitText := 'No Value';
setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
cboSubmit.Font.Color := clGrayText; cboSubmit.Font.Color := clGrayText;
end; end;
end end
@ -300,6 +322,10 @@ begin
cboSubmit.ItemIndex := -1 ; cboSubmit.ItemIndex := -1 ;
lblSubmit.Enabled := False; lblSubmit.Enabled := False;
cboSubmit.Enabled := False; cboSubmit.Enabled := False;
//TDP - CQ#19393 cboSubmit 508 changes
cboSubmitText := cboSubmit.Text;
if cboSubmitText = '' then cboSubmitText := 'No Value';
setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
cboSubmit.Font.Color := clGrayText; cboSubmit.Font.Color := clGrayText;
end; end;
chkIsolation.Checked := PatientOnIsolationProcedures(Patient.DFN) ; chkIsolation.Checked := PatientOnIsolationProcedures(Patient.DFN) ;
@ -310,7 +336,6 @@ begin
StatusText('Initializing Long List'); StatusText('Initializing Long List');
cboProcedure.InitLongList('') ; cboProcedure.InitLongList('') ;
StatusText(''); StatusText('');
end; end;
procedure TfrmODRad.ControlChange(Sender: TObject); procedure TfrmODRad.ControlChange(Sender: TObject);
@ -350,6 +375,14 @@ begin
memOrder.Text := Responses.OrderText; memOrder.Text := Responses.OrderText;
end; end;
//TDP - CQ#19393 Made history memobox read text
procedure TfrmODRad.VA508ComponentAccessibility1StateQuery(Sender: TObject;
var Text: string);
begin
inherited;
Text := memHistory.Text;
end;
procedure TfrmODRad.Validate(var AnErrMsg: string); procedure TfrmODRad.Validate(var AnErrMsg: string);
var var
i, j: integer; i, j: integer;
@ -638,6 +671,8 @@ begin
PreserveControl(memHistory); {WPB-1298-30758} PreserveControl(memHistory); {WPB-1298-30758}
if (Patient.Sex <> 'F') then if (Patient.Sex <> 'F') then
begin begin
//TDP - CQ#19393 change to allow grpPregnant to be tabbed to if screen reader active
if ScreenReaderSystemActive then grpPregnant.TabStop := True;
radPregnant.Enabled := False; radPregnant.Enabled := False;
radPregnantNo.Enabled := False; radPregnantNo.Enabled := False;
radPregnantUnknown.Enabled := False; radPregnantUnknown.Enabled := False;
@ -694,7 +729,10 @@ end;
procedure TfrmODRad.SetDefaultPregant; procedure TfrmODRad.SetDefaultPregant;
begin begin
if (Patient.Sex = 'F') and ((Patient.Age > 55) or (Patient.Age < 12)) then if (Patient.Sex = 'F') and ((Patient.Age > 55) or (Patient.Age < 12)) then
begin
radPregnantNo.Checked := True; radPregnantNo.Checked := True;
grpPregnant.TabStop := False;
end;
end; end;
procedure TfrmODRad.cmdAcceptClick(Sender: TObject); procedure TfrmODRad.cmdAcceptClick(Sender: TObject);
@ -719,6 +757,18 @@ begin
inherited; inherited;
end; end;
//TDP - CQ#19393 cboSubmit 508 changes. Can change in future to be generic if needed. (See fODLab.pas)
procedure TfrmODRad.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
begin
if ScreenReaderSystemActive and not ctrl.Enabled then begin
lbl.Enabled := True;
lbl.Visible := True;
lbl.Caption := lblSubmit.Caption + '. Read Only. Value is ' + Text;
lbl.Width := lblSubmit.Width + 2;
end else
lbl.Visible := false;
end;
procedure TfrmODRad.cboProcedureExit(Sender: TObject); procedure TfrmODRad.cboProcedureExit(Sender: TObject);
var var
i: integer; i: integer;
@ -738,6 +788,8 @@ begin
with lstSelectMod do with lstSelectMod do
for i := 0 to Items.Count - 1 do for i := 0 to Items.Count - 1 do
Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2)); Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
//TDP - Made Order Message next focus if showing and Tab or Entered was pressed
if (pnlMessage.Showing) AND ((TabIsPressed()) OR (EnterIsPressed())) then memMessage.SetFocus;
end; end;
@ -779,6 +831,24 @@ begin
result := not ((radPregnant.Checked) or (radPregnantNo.Checked) or (radPregnantUnknown.Checked)); result := not ((radPregnant.Checked) or (radPregnantNo.Checked) or (radPregnantUnknown.Checked));
end; end;
{TDP - Added to control where focus went now that pnlMessage was being focused
out of turn after cboProcedure.}
procedure TfrmODRad.pnlMessageExit(Sender: TObject);
begin
inherited;
if TabIsPressed() then cboAvailMod.SetFocus;
if ShiftTabIsPressed() then cboProcedure.SetFocus;
end;
{TDP - Added to control where focus went now that pnlMessage was being focused
out of turn after cboProcedure.}
procedure TfrmODRad.pnlMessageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited;
cboProcedure.SetFocus;
end;
procedure TfrmODRad.cboImTypeDropDownClose(Sender: TObject); procedure TfrmODRad.cboImTypeDropDownClose(Sender: TObject);
begin begin
inherited; inherited;

2
CPRS-Chart/Orders/fODRadConShRes.dfm
View File

@ -8,6 +8,8 @@ inherited frmODRadConShRes: TfrmODRadConShRes
ClientWidth = 288 ClientWidth = 288
OldCreateOrder = True OldCreateOrder = True
Position = poScreenCenter Position = poScreenCenter
ExplicitWidth = 294
ExplicitHeight = 146
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pnlBase: TORAutoPanel [0] object pnlBase: TORAutoPanel [0]

9
CPRS-Chart/Orders/fODRadConShRes.pas
View File

@ -59,7 +59,9 @@ begin
txtResearch.Enabled := False; txtResearch.Enabled := False;
Enabled := True; Enabled := True;
SelectByID(Piece(Source,U,1)); SelectByID(Piece(Source,U,1));
BringToFront; cboSource.Visible := True;
txtResearch.Visible := False;
//BringToFront;
ShowModal; ShowModal;
end end
{else if Items.Count = 1 then {else if Items.Count = 1 then
@ -70,7 +72,10 @@ begin
else if SrcType = 'R' then else if SrcType = 'R' then
begin begin
cboSource.Enabled := False; cboSource.Enabled := False;
txtResearch.BringToFront; cboSource.Visible := False;
srcLabel.Caption := 'Enter Source:';
txtResearch.Visible := True;
//txtResearch.BringToFront;
txtResearch.Text := Source; txtResearch.Text := Source;
ShowModal; ShowModal;
FSource := txtResearch.Text; FSource := txtResearch.Text;

2
CPRS-Chart/Orders/fODReleaseEvent.dfm
View File

@ -8,7 +8,7 @@ inherited frmOrdersReleaseEvent: TfrmOrdersReleaseEvent
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
ExplicitWidth = 494 ExplicitWidth = 494
ExplicitHeight = 488 ExplicitHeight = 495
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblRelease: TLabel [0] object lblRelease: TLabel [0]

10
CPRS-Chart/Orders/fODReleaseEvent.pas
View File

@ -117,15 +117,19 @@ begin
StatusText('Releasing Orders to Service...'); StatusText('Releasing Orders to Service...');
SendReleaseOrders(OrdersLst); SendReleaseOrders(OrdersLst);
LastCheckedPtEvt := ''; LastCheckedPtEvt := '';
//CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
with OrdersLst do if Count > 0 then for i := 0 to Count - 1 do with OrdersLst do if Count > 0 then for i := 0 to Count - 1 do
begin begin
if Pos('E', Piece(OrdersLst[i], U, 2)) > 0 then if Pos('E', Piece(OrdersLst[i], U, 2)) > 0 then
begin begin
OrderText := FindOrderText(Piece(OrdersLst[i], U, 1)); OrderText := FindOrderText(Piece(OrdersLst[i], U, 1));
if Piece(OrdersLst[i],U,4) = 'Invalid Pharmacy order number' then if Piece(OrdersLst[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF + InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.', TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
TC_SAVERR, MB_OK) else if Piece(OrdersLst[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
else else
InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText, InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,
TC_SAVERR, MB_OK); TC_SAVERR, MB_OK);

40
CPRS-Chart/Orders/fODText.dfm
View File

@ -1,5 +1,10 @@
inherited frmODText: TfrmODText inherited frmODText: TfrmODText
Width = 525
Height = 279
Anchors = [akLeft, akTop, akBottom]
Caption = 'Text Only Order' Caption = 'Text Only Order'
ExplicitWidth = 525
ExplicitHeight = 279
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblText: TLabel [0] object lblText: TLabel [0]
@ -23,18 +28,23 @@ inherited frmODText: TfrmODText
Height = 13 Height = 13
Caption = 'Stop Date/Time' Caption = 'Stop Date/Time'
end end
inherited memOrder: TCaptionMemo object lblOrderSig: TLabel [3]
TabOrder = 6 Left = 8
Top = 178
Width = 44
Height = 13
Caption = 'Order Sig'
end end
inherited cmdAccept: TButton inherited memOrder: TCaptionMemo
TabOrder = 3 TabOrder = 4
end end
object memText: TMemo [5] object memText: TMemo [5]
Left = 6 Left = 6
Top = 18 Top = 18
Width = 508 Width = 508
Height = 124 Height = 124
TabOrder = 0 Anchors = [akLeft, akTop, akBottom]
TabOrder = 1
OnChange = ControlChange OnChange = ControlChange
end end
object txtStart: TORDateBox [6] object txtStart: TORDateBox [6]
@ -42,7 +52,7 @@ inherited frmODText: TfrmODText
Top = 164 Top = 164
Width = 140 Width = 140
Height = 21 Height = 21
TabOrder = 1 TabOrder = 2
OnChange = ControlChange OnChange = ControlChange
DateOnly = False DateOnly = False
RequireTime = False RequireTime = False
@ -53,17 +63,20 @@ inherited frmODText: TfrmODText
Top = 164 Top = 164
Width = 140 Width = 140
Height = 21 Height = 21
TabOrder = 2 TabOrder = 3
OnChange = ControlChange OnChange = ControlChange
DateOnly = False DateOnly = False
RequireTime = False RequireTime = False
Caption = 'Stop Date/Time' Caption = 'Stop Date/Time'
end end
inherited cmdAccept: TButton
TabOrder = 5
end
inherited cmdQuit: TButton inherited cmdQuit: TButton
TabOrder = 4 TabOrder = 6
end end
inherited pnlMessage: TPanel inherited pnlMessage: TPanel
TabOrder = 5 TabOrder = 0
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
@ -78,7 +91,8 @@ inherited frmODText: TfrmODText
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = memOrder' 'Component = memOrder'
'Status = stsDefault') 'Label = lblOrderSig'
'Status = stsOK')
( (
'Component = cmdAccept' 'Component = cmdAccept'
'Status = stsDefault') 'Status = stsDefault')
@ -95,4 +109,10 @@ inherited frmODText: TfrmODText
'Component = frmODText' 'Component = frmODText'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object VA508CompMemOrder: TVA508ComponentAccessibility
Component = memOrder
OnStateQuery = VA508CompMemOrderStateQuery
Left = 152
Top = 216
end
end end

10
CPRS-Chart/Orders/fODText.pas
View File

@ -15,9 +15,12 @@ type
txtStop: TORDateBox; txtStop: TORDateBox;
lblStart: TLabel; lblStart: TLabel;
lblStop: TLabel; lblStop: TLabel;
VA508CompMemOrder: TVA508ComponentAccessibility;
lblOrderSig: TLabel;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure ControlChange(Sender: TObject); procedure ControlChange(Sender: TObject);
procedure cmdAcceptClick(Sender: TObject); procedure cmdAcceptClick(Sender: TObject);
procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
public public
procedure InitDialog; override; procedure InitDialog; override;
procedure SetupDialog(OrderAction: Integer; const ID: string); override; procedure SetupDialog(OrderAction: Integer; const ID: string); override;
@ -71,6 +74,13 @@ begin
else txtStart.Text := 'NOW'; else txtStart.Text := 'NOW';
end; end;
procedure TfrmODText.VA508CompMemOrderStateQuery(Sender: TObject;
var Text: string);
begin
inherited;
Text := memOrder.Text;
end;
procedure TfrmODText.Validate(var AnErrMsg: string); procedure TfrmODText.Validate(var AnErrMsg: string);
const const
SPACE_CHAR = 32; SPACE_CHAR = 32;

3
CPRS-Chart/Orders/fOMNavA.pas
View File

@ -646,8 +646,9 @@ begin
inherited; inherited;
if grdMenu.Objects[grdMenu.Col, grdMenu.Row] is TOrderMenuItem then begin if grdMenu.Objects[grdMenu.Col, grdMenu.Row] is TOrderMenuItem then begin
OrderMenuItem := TOrderMenuItem(grdMenu.Objects[grdMenu.Col, grdMenu.Row]); OrderMenuItem := TOrderMenuItem(grdMenu.Objects[grdMenu.Col, grdMenu.Row]);
Text := OrderMenuItem.Mnemonic + ', ' + OrderMenuItem.ItemText;
if OrderMenuItem.AutoAck then if OrderMenuItem.AutoAck then
Text := 'Auto Accept, '+ OrderMenuItem.ItemText; Text := 'Auto Accept, '+ Text;
end; end;
end; end;

75
CPRS-Chart/Orders/fOMSet.pas
View File

@ -108,15 +108,17 @@ procedure TfrmOMSet.DoNextItem;
var var
SetItem: TSetItem; SetItem: TSetItem;
theOwner: TComponent; theOwner: TComponent;
ok: boolean;
procedure SkipToNext; procedure SkipToNext;
begin begin
if FClosing then Exit;
lstSet.Checked[lstSet.ItemIndex] := True; lstSet.Checked[lstSet.ItemIndex] := True;
DoNextItem; DoNextItem;
end; end;
begin begin
DoingNextItem := true; DoingNextItem := true;
//frmFrame.UpdatePtInfoOnRefresh; //frmFrame.UpdatePtInfoOnRefresh;
if FClosing then Exit; if FClosing then Exit;
if frmOrders <> nil then if frmOrders <> nil then
@ -143,11 +145,40 @@ begin
case SetItem.DialogType of case SetItem.DialogType of
'A': if not ActivateAction(IntToStr(SetItem.DialogIEN), Self, ItemIndex) then 'A': if not ActivateAction(IntToStr(SetItem.DialogIEN), Self, ItemIndex) then
begin begin
if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then if Not FClosing then
lstSet.Checked[lstSet.ItemIndex] := True begin
else SkipToNext; if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
lstSet.Checked[lstSet.ItemIndex] := True
else SkipToNext;
end;
end; end;
'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then 'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then
begin
if Not FClosing then
begin
if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
lstSet.Checked[lstSet.ItemIndex] := True
else SkipToNext;
end;
end;
'M': begin
ok := ActivateOrderMenu(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex);
if not FClosing then
begin
if ok then
Inc(FActiveMenus)
else
begin
if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
lstSet.Checked[lstSet.ItemIndex] := True
else
SkipToNext;
end;
end;
end;
'O': begin
if (Self.Owner.Name = 'frmOMNavA') then theOwner := Self.Owner else theOwner := self;
if not ActivateOrderSet( IntToStr(SetItem.DialogIEN), FDelayEvent, theOwner, ItemIndex) then
begin begin
if Not FClosing then if Not FClosing then
begin begin
@ -156,23 +187,6 @@ begin
else SkipToNext; else SkipToNext;
end; end;
end; end;
'M': if ActivateOrderMenu( IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex)
then Inc(FActiveMenus)
else
begin
if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
lstSet.Checked[lstSet.ItemIndex] := True
else
SkipToNext;
end;
'O': begin
if (Self.Owner.Name = 'frmOMNavA') then theOwner := Self.Owner else theOwner := self;
if not ActivateOrderSet( IntToStr(SetItem.DialogIEN), FDelayEvent, theOwner, ItemIndex) then
begin
if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
lstSet.Checked[lstSet.ItemIndex] := True
else SkipToNext;
end;
end; end;
else begin else begin
InfoBox('Unsupported dialog type: ' + SetItem.DialogType, 'Error', MB_OK); InfoBox('Unsupported dialog type: ' + SetItem.DialogType, 'Error', MB_OK);
@ -185,12 +199,21 @@ end;
procedure TfrmOMSet.UMDelayEvent(var Message: TMessage); procedure TfrmOMSet.UMDelayEvent(var Message: TMessage);
begin begin
if CloseRequested then
begin
Close;
if Not FClosing then
begin
CloseRequested := False;
FClosing := False;
DoNextItem;
end
else Exit;
end;
// ignore if delay from other than current itemindex // ignore if delay from other than current itemindex
// (prevents completion of an order set from calling DoNextItem) // (prevents completion of an order set from calling DoNextItem)
if Message.WParam = lstSet.ItemIndex then if Message.WParam = lstSet.ItemIndex then
if lstSet.ItemIndex < lstSet.Items.Count - 1 then DoNextItem else Close; if lstSet.ItemIndex < lstSet.Items.Count - 1 then DoNextItem else Close;
if CloseRequested then
Close;
end; end;
procedure TfrmOMSet.UMDestroy(var Message: TMessage); procedure TfrmOMSet.UMDestroy(var Message: TMessage);
@ -251,6 +274,7 @@ begin
CanClose := True CanClose := True
else if lstSet.ItemIndex < (lstSet.Items.Count - 1) else if lstSet.ItemIndex < (lstSet.Items.Count - 1)
then CanClose := InfoBox(TX_STOP, TC_STOP, MB_YESNO) = IDYES; then CanClose := InfoBox(TX_STOP, TC_STOP, MB_YESNO) = IDYES;
FClosing := CanClose;
end; end;
procedure TfrmOMSet.FormClose(Sender: TObject; var Action: TCloseAction); procedure TfrmOMSet.FormClose(Sender: TObject; var Action: TCloseAction);
@ -280,7 +304,10 @@ end;
procedure TfrmOMSet.cmdInteruptClick(Sender: TObject); procedure TfrmOMSet.cmdInteruptClick(Sender: TObject);
begin begin
if DoingNextItem then if DoingNextItem then
CloseRequested := true //Fix for CQ: 8297 begin
CloseRequested := true; //Fix for CQ: 8297
FClosing := true;
end
else else
Close; Close;
end; end;

14
CPRS-Chart/Orders/fOMVerify.dfm
View File

@ -7,6 +7,7 @@ inherited frmOMVerify: TfrmOMVerify
ClientWidth = 579 ClientWidth = 579
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow
ExplicitWidth = 587 ExplicitWidth = 587
ExplicitHeight = 208 ExplicitHeight = 208
PixelsPerInch = 96 PixelsPerInch = 96
@ -45,6 +46,7 @@ inherited frmOMVerify: TfrmOMVerify
Top = 6 Top = 6
Width = 567 Width = 567
Height = 132 Height = 132
TabStop = False
Font.Charset = ANSI_CHARSET Font.Charset = ANSI_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
@ -64,11 +66,12 @@ inherited frmOMVerify: TfrmOMVerify
'9' '9'
'10') '10')
ParentFont = False ParentFont = False
ReadOnly = True
ScrollBars = ssBoth ScrollBars = ssBoth
TabOrder = 3 TabOrder = 3
WantTabs = True WantTabs = True
WordWrap = False WordWrap = False
OnKeyUp = memTextKeyUp OnKeyDown = memTextKeyDown
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (
@ -83,9 +86,16 @@ inherited frmOMVerify: TfrmOMVerify
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = memText' 'Component = memText'
'Status = stsDefault') 'Text = Order information.'
'Status = stsOK')
( (
'Component = frmOMVerify' 'Component = frmOMVerify'
'Status = stsDefault')) 'Status = stsDefault'))
end end
object VA508ComponentAccessibility1: TVA508ComponentAccessibility
Component = memText
OnStateQuery = VA508ComponentAccessibility1StateQuery
Left = 48
Top = 32
end
end end

91
CPRS-Chart/Orders/fOMVerify.pas
View File

@ -4,7 +4,7 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager; fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager, VA508AccessibilityRouter;
type type
TfrmOMVerify = class(TfrmAutoSz) TfrmOMVerify = class(TfrmAutoSz)
@ -12,6 +12,7 @@ type
cmdEdit: TButton; cmdEdit: TButton;
cmdCancel: TButton; cmdCancel: TButton;
memText: TRichEdit; memText: TRichEdit;
VA508ComponentAccessibility1: TVA508ComponentAccessibility;
procedure cmdAcceptClick(Sender: TObject); procedure cmdAcceptClick(Sender: TObject);
procedure cmdEditClick(Sender: TObject); procedure cmdEditClick(Sender: TObject);
procedure cmdCancelClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject);
@ -19,12 +20,20 @@ type
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure memTextKeyUp(Sender: TObject; var Key: Word; procedure memTextKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
procedure FormDestroy(Sender: TObject);
procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
var Text: string);
procedure FormShow(Sender: TObject);
procedure memTextKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private private
FLevel: Integer; FLevel: Integer;
end; end;
procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean = False); procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean = False);
var
frmOMVerify: TfrmOMVerify;
implementation implementation
{$R *.DFM} {$R *.DFM}
@ -33,7 +42,7 @@ uses ORFn, uConst, fFrame, rMisc, uODBase;
procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean); procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean);
var var
frmOMVerify: TfrmOMVerify; //frmOMVerify: TfrmOMVerify;
tempStrs,prompts: TStringList; tempStrs,prompts: TStringList;
flag: boolean; flag: boolean;
HasObjects: boolean; HasObjects: boolean;
@ -67,7 +76,6 @@ begin
prompts.Add('pick up'); prompts.Add('pick up');
prompts.Add('priority'); prompts.Add('priority');
frmOMVerify := TfrmOMVerify.Create(Application); frmOMVerify := TfrmOMVerify.Create(Application);
try
ResizeFormToFont(TForm(frmOMVerify)); ResizeFormToFont(TForm(frmOMVerify));
if InptDispGrp then if InptDispGrp then
begin begin
@ -78,47 +86,65 @@ begin
until not flag; until not flag;
SetString(VerifyText, tempStrs.GetText, StrLen(tempStrs.GetText)) SetString(VerifyText, tempStrs.GetText, StrLen(tempStrs.GetText))
end; end;
with frmOMVerify do
begin
SetBounds(frmFrame.Left, frmFrame.Top + frmFrame.Height - Height, Width, Height);
SetFormPosition(frmOMVerify); SetFormPosition(frmOMVerify);
ExpandOrderObjects(VerifyText, HasObjects); ExpandOrderObjects(VerifyText, HasObjects);
memText.Lines.SetText(PChar(VerifyText)); frmOMVerify.memText.Lines.SetText(PChar(VerifyText));
ShowModal; frmOMVerify.ShowModal;
QuickLevel := FLevel; if frmOMVerify.ModalResult = mrOK then
end; begin
finally QuickLevel := frmOMVerify.FLevel;
frmOMVerify.Release; end;
end; //agp on CPRS timeout ModalResult equal mrCancel this prevent starting a new order
//when the chart is timing out.
if frmOMVerify.ModalResult = mrCancel then QuickLevel := QL_CANCEL;
frmOMVerify.Free;
end; end;
procedure TfrmOMVerify.FormCreate(Sender: TObject); procedure TfrmOMVerify.FormCreate(Sender: TObject);
begin begin
inherited; inherited;
frmOMVerify := nil;
FLevel := QL_CANCEL; FLevel := QL_CANCEL;
ModalResult := mrNone;
end;
procedure TfrmOMVerify.FormDestroy(Sender: TObject);
begin
inherited;
frmOMVerify := nil;
end;
procedure TfrmOMVerify.FormShow(Sender: TObject);
begin
inherited;
if ScreenReaderSystemActive then
begin
memText.TabStop := true;
memText.SetFocus;
end;
end; end;
procedure TfrmOMVerify.cmdAcceptClick(Sender: TObject); procedure TfrmOMVerify.cmdAcceptClick(Sender: TObject);
begin begin
inherited; inherited;
FLevel := QL_AUTO; FLevel := QL_AUTO;
Close; ModalResult := mrOK;
end; end;
procedure TfrmOMVerify.cmdEditClick(Sender: TObject); procedure TfrmOMVerify.cmdEditClick(Sender: TObject);
begin begin
inherited; inherited;
FLevel := QL_DIALOG; FLevel := QL_DIALOG;
Close; ModalResult := mrOK;
end; end;
procedure TfrmOMVerify.cmdCancelClick(Sender: TObject); procedure TfrmOMVerify.cmdCancelClick(Sender: TObject);
begin begin
inherited; inherited;
FLevel := QL_CANCEL; FLevel := QL_CANCEL;
Close; ModalResult := mrOK;
end; end;
procedure TfrmOMVerify.FormClose(Sender: TObject; procedure TfrmOMVerify.FormClose(Sender: TObject;
@ -128,11 +154,31 @@ begin
SaveUserBounds(Self); SaveUserBounds(Self);
end; end;
procedure TfrmOMVerify.memTextKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if ShiftTabIsPressed() then
begin
FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
Key := 0;
end;
if TabIsPressed() then
begin
FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
Key := 0;
end;
if (key = VK_ESCAPE) then begin
FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
key := 0;
end;
end;
procedure TfrmOMVerify.memTextKeyUp(Sender: TObject; var Key: Word; procedure TfrmOMVerify.memTextKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
begin begin
inherited; inherited;
if (Key = VK_TAB) then {if (Key = VK_TAB) then
begin begin
if ssShift in Shift then if ssShift in Shift then
begin begin
@ -148,7 +194,14 @@ begin
if (key = VK_ESCAPE) then begin if (key = VK_ESCAPE) then begin
FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
key := 0; key := 0;
end; end; }
end;
procedure TfrmOMVerify.VA508ComponentAccessibility1StateQuery(Sender: TObject;
var Text: string);
begin
inherited;
Text := memText.Text;
end; end;
end. end.

22
CPRS-Chart/Orders/fOrders.dfm
View File

@ -3,34 +3,34 @@ inherited frmOrders: TfrmOrders
Top = 177 Top = 177
HelpContext = 4000 HelpContext = 4000
Caption = 'Orders Page' Caption = 'Orders Page'
ClientHeight = 571 ClientHeight = 591
ClientWidth = 766 ClientWidth = 766
HelpFile = 'overvw' HelpFile = 'overvw'
Menu = mnuOrders Menu = mnuOrders
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnShow = FormShow OnShow = FormShow
ExplicitWidth = 774 ExplicitWidth = 774
ExplicitHeight = 617 ExplicitHeight = 645
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
inherited shpPageBottom: TShape inherited shpPageBottom: TShape
Top = 566 Top = 586
Width = 766 Width = 766
ExplicitTop = 528 ExplicitTop = 528
ExplicitWidth = 766 ExplicitWidth = 766
end end
inherited sptHorz: TSplitter inherited sptHorz: TSplitter
Left = 117 Left = 117
Height = 566 Height = 586
OnMoved = sptHorzMoved OnMoved = sptHorzMoved
ExplicitLeft = 117 ExplicitLeft = 117
ExplicitHeight = 528 ExplicitHeight = 528
end end
inherited pnlLeft: TPanel inherited pnlLeft: TPanel
Width = 117 Width = 117
Height = 566 Height = 586
ExplicitWidth = 117 ExplicitWidth = 117
ExplicitHeight = 566 ExplicitHeight = 586
object OROffsetLabel1: TOROffsetLabel object OROffsetLabel1: TOROffsetLabel
Left = 0 Left = 0
Top = 0 Top = 0
@ -63,6 +63,7 @@ inherited frmOrders: TfrmOrders
Height = 4 Height = 4
Cursor = crVSplit Cursor = crVSplit
Align = alTop Align = alTop
OnMoved = sptVertMoved
end end
object lstSheets: TORListBox object lstSheets: TORListBox
Left = 0 Left = 0
@ -70,6 +71,7 @@ inherited frmOrders: TfrmOrders
Width = 117 Width = 117
Height = 56 Height = 56
Align = alTop Align = alTop
Constraints.MinHeight = 30
ItemHeight = 13 ItemHeight = 13
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
@ -84,7 +86,7 @@ inherited frmOrders: TfrmOrders
Left = 0 Left = 0
Top = 116 Top = 116
Width = 117 Width = 117
Height = 450 Height = 470
Align = alClient Align = alClient
ItemHeight = 13 ItemHeight = 13
ParentShowHint = False ParentShowHint = False
@ -111,14 +113,14 @@ inherited frmOrders: TfrmOrders
inherited pnlRight: TPanel inherited pnlRight: TPanel
Left = 121 Left = 121
Width = 645 Width = 645
Height = 566 Height = 586
ParentColor = True ParentColor = True
ParentCtl3D = False ParentCtl3D = False
ParentFont = False ParentFont = False
OnResize = pnlRightResize OnResize = pnlRightResize
ExplicitLeft = 121 ExplicitLeft = 121
ExplicitWidth = 645 ExplicitWidth = 645
ExplicitHeight = 566 ExplicitHeight = 586
object lblOrders: TOROffsetLabel object lblOrders: TOROffsetLabel
Left = 0 Left = 0
Top = 0 Top = 0
@ -225,7 +227,7 @@ inherited frmOrders: TfrmOrders
Left = 0 Left = 0
Top = 36 Top = 36
Width = 645 Width = 645
Height = 530 Height = 550
Style = lbOwnerDrawVariable Style = lbOwnerDrawVariable
Align = alClient Align = alClient
Color = clCream Color = clCream

46
CPRS-Chart/Orders/fOrders.pas
View File

@ -162,6 +162,7 @@ type
procedure hdrOrdersSectionClick(HeaderControl: THeaderControl; procedure hdrOrdersSectionClick(HeaderControl: THeaderControl;
Section: THeaderSection); Section: THeaderSection);
procedure sptHorzMoved(Sender: TObject); procedure sptHorzMoved(Sender: TObject);
procedure sptVertMoved(Sender: TObject);
private private
{ Private declarations } { Private declarations }
OrderListClickProcessing : Boolean; OrderListClickProcessing : Boolean;
@ -224,7 +225,7 @@ type
function getTotalSectionsWidth : integer; //CQ6170 function getTotalSectionsWidth : integer; //CQ6170
function AllowContextChange(var WhyNot: string): Boolean; override; function AllowContextChange(var WhyNot: string): Boolean; override;
function PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean; function PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean;
function PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean = False): boolean; function PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean = False; Signing: boolean = False): boolean;
procedure RefreshToFirstItem; procedure RefreshToFirstItem;
procedure ChangesUpdate(APtEvtID: string); procedure ChangesUpdate(APtEvtID: string);
procedure GroupChangesUpdate(GrpName: string); procedure GroupChangesUpdate(GrpName: string);
@ -1175,7 +1176,9 @@ begin
if AnOrderView.EventDelay.PtEventIFN > 0 then if AnOrderView.EventDelay.PtEventIFN > 0 then
FCompress := False; FCompress := False;
end; end;
//CQ 18660 Orders for events should be modal. Orders for non-event should not be modal
if AnOrderView.EventDelay.EventIFN = 0 then NeedShowModal := False
else NeedShowModal := True;
if (FCurrentView <> nil) and (AnOrderView.EventDelay.EventIFN <> FCurrentView.EventDelay.EventIFN) and (FCurrentView.EventDelay.EventIFN > 0 ) then if (FCurrentView <> nil) and (AnOrderView.EventDelay.EventIFN <> FCurrentView.EventDelay.EventIFN) and (FCurrentView.EventDelay.EventIFN > 0 ) then
begin begin
APtEvtID := IntToStr(FCurrentView.EventDelay.PtEventIFN); APtEvtID := IntToStr(FCurrentView.EventDelay.PtEventIFN);
@ -1397,7 +1400,9 @@ begin
4: 4:
begin begin
result := MixedCase(ProviderName); result := MixedCase(ProviderName);
result := Piece(result, ',', 1) + ',' + Copy(Piece(result, ',', 2), 1, 1); // result := Piece(result, ',', 1) + ',' + Copy(Piece(result, ',', 2), 1, 1);
// CQ#15915
result := Piece(result, ',', 1) + ',' + Piece(result, ',', 2);
end; end;
5: result := VerNurse; 5: result := VerNurse;
6: result := VerClerk; 6: result := VerClerk;
@ -2349,8 +2354,10 @@ var
SelectedList: TList; SelectedList: TList;
ALocation: Integer; ALocation: Integer;
AName: string; AName: string;
Delayed: boolean;
begin begin
inherited; inherited;
Delayed := False;
if NoneSelected(TX_NOSEL_SIGN) then Exit; if NoneSelected(TX_NOSEL_SIGN) then Exit;
if not AuthorizedUser then Exit; if not AuthorizedUser then Exit;
if (User.OrderRole <> 2) and (User.OrderRole <> 3) then if (User.OrderRole <> 2) and (User.OrderRole <> 3) then
@ -2374,8 +2381,11 @@ begin
end; end;
if not LockedForOrdering then Exit; if not LockedForOrdering then Exit;
if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then //CQ 18392 and CQ 18121 Made changes to this code, PtEVTComplete function and the finally statement at the end to support the fix for these CQs
Exit; if (FCurrentView.EventDelay.PtEventIFN>0) then
Delayed := (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName, false, true));
//if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
// Exit;
SelectedList := TList.Create; SelectedList := TList.Create;
try try
@ -2412,6 +2422,16 @@ begin
finally finally
SelectedList.Free; SelectedList.Free;
UnlockIfAble; UnlockIfAble;
//CQ #17491: Added UpdatePtInfoOnRefresh here to allow for the updating of the patient
//status indicator in the header bar if the patient becomes admitted/discharged.
frmFrame.UpdatePtInfoOnRefresh;
if Delayed = True then
begin
InitOrderSheetsForEvtDelay;
lstSheets.ItemIndex := 0;
lstSheetsClick(self);
RefreshOrderList(True);
end;
end; end;
end; end;
@ -3242,7 +3262,7 @@ begin
end; end;
end; end;
function TfrmOrders.PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean): boolean; function TfrmOrders.PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean; Signing: boolean): boolean;
begin begin
Result := False; Result := False;
if IsCompletedPtEvt(APtEvtID) then if IsCompletedPtEvt(APtEvtID) then
@ -3252,6 +3272,11 @@ begin
else else
InfoBox('The event "Delayed ' + APtEvtName + '" ' + TX_CMPTEVT, 'Warning', MB_OK or MB_ICONWARNING); InfoBox('The event "Delayed ' + APtEvtName + '" ' + TX_CMPTEVT, 'Warning', MB_OK or MB_ICONWARNING);
GroupChangesUpdate('Delayed ' + APtEvtName); GroupChangesUpdate('Delayed ' + APtEvtName);
if signing = true then
begin
Result := True;
exit;
end;
InitOrderSheetsForEvtDelay; InitOrderSheetsForEvtDelay;
lstSheets.ItemIndex := 0; lstSheets.ItemIndex := 0;
lstSheetsClick(self); lstSheetsClick(self);
@ -3337,6 +3362,7 @@ begin
for i := 0 to hdrOrders.Sections.Count - 1 do for i := 0 to hdrOrders.Sections.Count - 1 do
hdrOrders.Sections[i].Width := origWidths[i]; hdrOrders.Sections[i].Width := origWidths[i];
lstOrders.Invalidate; lstOrders.Invalidate;
RefreshOrderList(false);
end; end;
end; end;
//end CQ6170 //end CQ6170
@ -3473,6 +3499,14 @@ begin
mnuOptimizeFieldsClick(self); mnuOptimizeFieldsClick(self);
end; end;
procedure TfrmOrders.sptVertMoved(Sender: TObject);
begin
inherited;
if self.sptVert.Top < self.lstSheets.Constraints.MinHeight then
self.sptVert.Top := self.lstSheets.Constraints.MinHeight + 1;
end;
initialization initialization
SpecifyFormIsNotADialog(TfrmOrders); SpecifyFormIsNotADialog(TfrmOrders);

1
CPRS-Chart/Orders/fOrdersDC.pas
View File

@ -79,6 +79,7 @@ begin
begin begin
frmDCOrders.lblReason.Visible := True; frmDCOrders.lblReason.Visible := True;
frmDCOrders.lstReason.Visible := True; frmDCOrders.lstReason.Visible := True;
frmDCOrders.lstReason.ScrollWidth := 10;
end else end else
begin begin
frmDCOrders.lblReason.Visible := False; frmDCOrders.lblReason.Visible := False;

2
CPRS-Chart/Orders/fOrdersOnChart.dfm
View File

@ -7,7 +7,7 @@ inherited frmOnChartOrders: TfrmOnChartOrders
Position = poScreenCenter Position = poScreenCenter
OnCreate = FormCreate OnCreate = FormCreate
ExplicitWidth = 470 ExplicitWidth = 470
ExplicitHeight = 368 ExplicitHeight = 375
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object Panel2: TPanel [0] object Panel2: TPanel [0]

9
CPRS-Chart/Orders/fOrdersOnChart.pas
View File

@ -92,15 +92,18 @@ begin
uCore.TempEncounterLoc := 0; uCore.TempEncounterLoc := 0;
uCore.TempEncounterLocName := ''; uCore.TempEncounterLocName := '';
//CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
with SignList do if Count > 0 then for i := 0 to Count - 1 do with SignList do if Count > 0 then for i := 0 to Count - 1 do
begin begin
if Pos('E', Piece(SignList[i], U, 2)) > 0 then if Pos('E', Piece(SignList[i], U, 2)) > 0 then
begin begin
OrderText := FindOrderText(Piece(SignList[i], U, 1)); OrderText := FindOrderText(Piece(SignList[i], U, 1));
if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF + InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.', TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
TC_SAVERR, MB_OK) else if Piece(SignList[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
else else
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
TC_SAVERR, MB_OK); TC_SAVERR, MB_OK);

2
CPRS-Chart/Orders/fOrdersRelease.dfm
View File

@ -5,8 +5,6 @@ inherited frmReleaseOrders: TfrmReleaseOrders
ClientHeight = 343 ClientHeight = 343
Position = poScreenCenter Position = poScreenCenter
OnCreate = FormCreate OnCreate = FormCreate
ExplicitLeft = 318
ExplicitTop = 186
ExplicitHeight = 377 ExplicitHeight = 377
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13

9
CPRS-Chart/Orders/fOrdersRelease.pas
View File

@ -127,15 +127,18 @@ begin
//hds7591 Clinic/Ward movement. //hds7591 Clinic/Ward movement.
//CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
with SignList do if Count > 0 then for i := 0 to Count - 1 do with SignList do if Count > 0 then for i := 0 to Count - 1 do
begin begin
if Pos('E', Piece(SignList[i], U, 2)) > 0 then if Pos('E', Piece(SignList[i], U, 2)) > 0 then
begin begin
OrderText := FindOrderText(Piece(SignList[i], U, 1)); OrderText := FindOrderText(Piece(SignList[i], U, 1));
if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF + InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.', TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
TC_SAVERR, MB_OK) else if Piece(SignList[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
else else
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
TC_SAVERR, MB_OK); TC_SAVERR, MB_OK);

5
CPRS-Chart/Orders/fOrdersRenew.dfm
View File

@ -57,7 +57,7 @@ inherited frmRenewOrders: TfrmRenewOrders
Cancel = True Cancel = True
Caption = 'Cancel' Caption = 'Cancel'
Constraints.MinHeight = 21 Constraints.MinHeight = 21
TabOrder = 0 TabOrder = 2
OnClick = cmdCancelClick OnClick = cmdCancelClick
end end
object cmdOK: TButton object cmdOK: TButton
@ -80,7 +80,7 @@ inherited frmRenewOrders: TfrmRenewOrders
Caption = 'Change...' Caption = 'Change...'
Constraints.MinHeight = 21 Constraints.MinHeight = 21
Enabled = False Enabled = False
TabOrder = 2 TabOrder = 0
OnClick = cmdChangeClick OnClick = cmdChangeClick
end end
end end
@ -110,6 +110,7 @@ inherited frmRenewOrders: TfrmRenewOrders
OnDrawItem = lstOrdersDrawItem OnDrawItem = lstOrdersDrawItem
OnMeasureItem = lstOrdersMeasureItem OnMeasureItem = lstOrdersMeasureItem
HintOnItem = True HintOnItem = True
ExplicitTop = 12
end end
inherited amgrMain: TVA508AccessibilityManager inherited amgrMain: TVA508AccessibilityManager
Data = ( Data = (

30
CPRS-Chart/Orders/fOrdersRenew.pas
View File

@ -261,8 +261,10 @@ begin
inherited; inherited;
FixHeaderControlDelphi2006Bug(hdrOrders); FixHeaderControlDelphi2006Bug(hdrOrders);
OKPressed := False; OKPressed := False;
hdrOrders.Sections[0].Width := Round(self.width * 0.75);
hdrOrders.Sections[1].Width := Round(self.width * 0.25);
ResizeFormToFont(Self); ResizeFormToFont(Self);
SetFormPosition(Self); SetFormPosition(Self);
end; end;
procedure TfrmRenewOrders.FormResize(Sender: TObject); procedure TfrmRenewOrders.FormResize(Sender: TObject);
@ -409,12 +411,28 @@ function TfrmRenewOrders.MeasureColumnHeight(TheOrderText: string; Index,
Column: integer): integer; Column: integer): integer;
var var
ARect: TRect; ARect: TRect;
cnt: integer;
x: string;
begin begin
cnt := 0;
ARect.Left := 0; ARect.Left := 0;
ARect.Top := 0; ARect.Top := 0;
ARect.Bottom := 0; ARect.Bottom := 0;
ARect.Right := hdrOrders.Sections[Column].Width -6; ARect.Right := hdrOrders.Sections[Column].Width -6;
Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect); Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect);
//AGP 28.0 this fix address the issue of WrappedTextHeightByFont appearing to not take in account CRLF
if Pos(CRLF, TheOrderText) > 0 then
begin
repeat
x := Copy(TheOrderText, 1, Pos(CRLF, TheOrderText) - 1);
if Length(x) = 0 then x := TheOrderText;
Delete(TheOrderText, 1, Length(x) + 2); {delete text + CRLF}
cnt := cnt + 1;
until TheOrderText = '';
if cnt > 0 then Result := Result + (cnt * Abs(self.Font.Height));
if Result > 255 then Result := 255;
end;
end; end;
function TfrmRenewOrders.AcceptOrderCheckOnRenew(const AnOrderID: string; function TfrmRenewOrders.AcceptOrderCheckOnRenew(const AnOrderID: string;
@ -422,12 +440,18 @@ function TfrmRenewOrders.AcceptOrderCheckOnRenew(const AnOrderID: string;
var var
OIInfo,FillerID: string; OIInfo,FillerID: string;
AnOIList: TStringList; AnOIList: TStringList;
subI: integer;
begin begin
AnOIList := TStringList.Create; AnOIList := TStringList.Create;
OIInfo := DataForOrderCheck(AnOrderID); OIInfo := DataForOrderCheck(AnOrderID);
FillerID := Piece(OIInfo,'^',2); FillerID := Piece(OIInfo,'^',2);
AnOIList.Add(OIInfo); subI := 1;
OrderChecksOnAccept(OCList, FillerID, '', AnOIList, AnOrderID); while Length(Piece(OIInfo,'|',subI))>1 do
begin
AnOIList.Add(Piece(OIInfo,'|',subI));
subI := subI + 1;
end;
OrderChecksOnAccept(OCList, FillerID, '', AnOIList, AnOrderID,'1');
Result := AcceptOrderWithChecks(OCList); Result := AcceptOrderWithChecks(OCList);
end; end;

2
CPRS-Chart/Orders/fOrdersSign.dfm
View File

@ -13,7 +13,7 @@ inherited frmSignOrders: TfrmSignOrders
OnResize = FormResize OnResize = FormResize
OnShow = FormShow OnShow = FormShow
ExplicitWidth = 841 ExplicitWidth = 841
ExplicitHeight = 514 ExplicitHeight = 521
DesignSize = ( DesignSize = (
833 833
487) 487)

43
CPRS-Chart/Orders/fOrdersSign.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fAutoSz, StdCtrls, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB, fAutoSz, StdCtrls, StrUtils, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB,
ComCtrls, CheckLst, ExtCtrls, uConsults, UBAGlobals,UBACore, UBAMessages, UBAConst, ComCtrls, CheckLst, ExtCtrls, uConsults, UBAGlobals,UBACore, UBAMessages, UBAConst,
Menus, ORClasses, fBase508Form, fPrintLocation, VA508AccessibilityManager; Menus, ORClasses, fBase508Form, fPrintLocation, VA508AccessibilityManager;
@ -210,11 +210,12 @@ var
cProvDUZ: Int64; cProvDUZ: Int64;
OrderText, ASvc: string; OrderText, ASvc: string;
PrintLoc: Integer; PrintLoc: Integer;
AList, ClinicList, DCList, OrderPrintList, WardList: TStringList; AList, ClinicList, OrderPrintList, WardList: TStringList;
EncLocName, EncLocText: string; EncLocName, EncLocText: string;
EncLocIEN: integer; EncLocIEN: integer;
EncDT: TFMDateTime; EncDT: TFMDateTime;
EncVC: Char; EncVC: Char;
//ChangeItem: TChangeItem;
function FindOrderText(const AnID: string): string; function FindOrderText(const AnID: string): string;
var var
@ -329,7 +330,7 @@ begin
UBAGlobals.NonBillableOrderList := rpcNonBillableOrders(tempOrderList); UBAGlobals.NonBillableOrderList := rpcNonBillableOrders(tempOrderList);
end; end;
frmSignOrders.ShowModal; frmSignOrders.ShowModal;
if frmSignOrders.OKPressed then if frmSignOrders.OKPressed then
begin begin
Result := True; Result := True;
@ -427,7 +428,6 @@ begin
begin begin
if (Patient.Inpatient = True) and (Encounter.Location <> Patient.Location) then if (Patient.Inpatient = True) and (Encounter.Location <> Patient.Location) then
begin begin
DCList := TStringList.Create;
EncLocName := Encounter.LocationName; EncLocName := Encounter.LocationName;
EncLocIEN := Encounter.Location; EncLocIEN := Encounter.Location;
EncLocText := Encounter.LocationText; EncLocText := Encounter.LocationText;
@ -439,21 +439,26 @@ begin
if frmSignOrders.clstOrders.Checked[cidx] = false then continue; if frmSignOrders.clstOrders.Checked[cidx] = false then continue;
if TOrder(SelectedList.Items[i]).DGroupName = 'Clinic Orders' then ContainsIMOOrders := true; if TOrder(SelectedList.Items[i]).DGroupName = 'Clinic Orders' then ContainsIMOOrders := true;
if TOrder(SelectedList.Items[i]).DGroupName = '' then continue; if TOrder(SelectedList.Items[i]).DGroupName = '' then continue;
if TOrder(SelectedList.Items[i]).EventPtr <> '' then continue; if (Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0) or
if Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0 then (TOrder(SelectedList.Items[i]).IsOrderPendDC = true) then
begin begin
DCList.Add(TOrder(SelectedList.Items[i]).ID); WardList.Add(TOrder(SelectedList.Items[i]).ID);
Continue; Continue;
end; end;
//ChangeItem := Changes.Locate(20,TOrder(SelectedList.Items[i]).ID);
//if ChangeItem = nil then continue;
//if ChangeItem.Delay = true then continue;
if TOrder(SelectedList.Items[i]).IsDelayOrder = true then continue;
OrderPrintList.Add(TOrder(SelectedList.Items[i]).ID + ':' + TOrder(SelectedList.Items[i]).Text); OrderPrintList.Add(TOrder(SelectedList.Items[i]).ID + ':' + TOrder(SelectedList.Items[i]).Text);
end; end;
if OrderPrintList.Count > 0 then begin frmPrintLocation.PrintLocation(OrderPrintList, EncLocIEN, EncLocName, EncLocText, EncDT, EncVC, ClinicList, WardList, WardIen,WardName, ContainsIMOOrders, true); fframe.frmFrame.OrderPrintForm := false; if OrderPrintList.Count > 0 then
end else DoNotPrint := True; if (DCList <> nil) and (DCList.Count > 0) then begin for i := 0 to DCList.Count - 1 do begin frmPrintLocation.PrintLocation(OrderPrintList, EncLocIEN, EncLocName, EncLocText, EncDT, EncVC, ClinicList,
WardList.Add(DCList.Strings[i]); WardList, WardIen,WardName, ContainsIMOOrders, true);
if (WardIEN = 0) and (WardName = '') then //fframe.frmFrame.OrderPrintForm := false;
CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc); end
end; if DCList <> nil then DCList.Free; end; else if (clinicList.count = 0) and (wardList.Count = 0) then DoNotPrint := True;
end; if (WardIEN = 0) and (WardName = '') then CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc);
end; end;
uCore.TempEncounterLoc := 0; uCore.TempEncounterLoc := 0;
uCore.TempEncounterLocName := ''; uCore.TempEncounterLocName := '';
//hds7591 Clinic/Ward movement Patient Admission IMO //hds7591 Clinic/Ward movement Patient Admission IMO
@ -462,15 +467,19 @@ begin
SendOrders(SignList, frmSignOrders.ESCode); SendOrders(SignList, frmSignOrders.ESCode);
end; end;
//CQ #15813 Modified code to look for error string mentioned in CQ and change strings to conts - JCS
//CQ #15813 Adjusted code to handle error message properly - TDP
with SignList do if Count > 0 then for i := 0 to Count - 1 do with SignList do if Count > 0 then for i := 0 to Count - 1 do
begin begin
if Pos('E', Piece(SignList[i], U, 2)) > 0 then if Pos('E', Piece(SignList[i], U, 2)) > 0 then
begin begin
OrderText := FindOrderText(Piece(SignList[i], U, 1)); OrderText := FindOrderText(Piece(SignList[i], U, 1));
if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF + InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.', TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
TC_SAVERR, MB_OK) else if AnsiContainsStr(Piece(SignList[i],U,4), TX_SAVERR_IMAGING_PROC_SEARCH_STRING) then
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
else else
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
TC_SAVERR, MB_OK); TC_SAVERR, MB_OK);

85
CPRS-Chart/Orders/fOrdersTS.dfm
View File

@ -8,20 +8,18 @@ inherited frmOrdersTS: TfrmOrdersTS
Constraints.MinWidth = 310 Constraints.MinWidth = 310
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
ExplicitLeft = 84
ExplicitTop = 77
ExplicitWidth = 464 ExplicitWidth = 464
ExplicitHeight = 385 ExplicitHeight = 385
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object pnlMiddle: TPanel [0] object pnlMiddle: TPanel [0]
Left = 0 Left = 0
Top = 78 Top = 60
Width = 456 Width = 456
Height = 56 Height = 56
Align = alTop Align = alTop
Constraints.MinHeight = 45 Constraints.MinHeight = 45
TabOrder = 0 TabOrder = 1
object grpChoice: TGroupBox object grpChoice: TGroupBox
Left = 1 Left = 1
Top = 1 Top = 1
@ -80,36 +78,37 @@ inherited frmOrdersTS: TfrmOrdersTS
Left = 0 Left = 0
Top = 0 Top = 0
Width = 456 Width = 456
Height = 78 Height = 60
Align = alTop Align = alTop
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
AutoSize = True AutoSize = True
BorderStyle = bsSingle BorderStyle = bsSingle
TabOrder = 1 TabOrder = 0
object lblPtInfo: TLabel object lblPtInfo: TVA508StaticText
Name = 'lblPtInfo'
Left = 1 Left = 1
Top = 1 Top = 1
Width = 3 Width = 450
Height = 34 Height = 34
Align = alTop Align = alTop
Color = clBtnFace Alignment = taLeftJustify
Constraints.MinHeight = 34 Constraints.MinHeight = 34
ParentColor = False TabOrder = 0
Layout = tlCenter ShowAccelChar = True
end end
object pnldif: TPanel object pnldif: TPanel
Left = 1 Left = 1
Top = 35 Top = 35
Width = 450 Width = 450
Height = 38 Height = 20
Align = alTop Align = alTop
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 0 TabOrder = 1
object Image1: TImage object Image1: TImage
Left = 1 Left = 1
Top = 1 Top = 1
Width = 24 Width = 24
Height = 22 Height = 18
Align = alLeft Align = alLeft
AutoSize = True AutoSize = True
Enabled = False Enabled = False
@ -130,52 +129,62 @@ inherited frmOrdersTS: TfrmOrdersTS
Transparent = True Transparent = True
ExplicitHeight = 36 ExplicitHeight = 36
end end
object Label1: TLabel object lblUseAdmit: TVA508StaticText
Name = 'lblUseAdmit'
Left = 34 Left = 34
Top = 4 Top = 4
Width = 327 Width = 329
Height = 13 Height = 15
Alignment = taLeftJustify
Caption = Caption =
'Use Admit: if patient is newly admitted to the hospital or nursi' + 'Use Admit: if patient is newly admitted to the hospital or nursi' +
'ng home.' 'ng home.'
TabOrder = 0
ShowAccelChar = True
end end
object Label2: TLabel object lblUseTransfer: TVA508StaticText
Name = 'lblUseTransfer'
Left = 34 Left = 34
Top = 21 Top = 21
Width = 361 Width = 363
Height = 13 Height = 15
Alignment = taLeftJustify
Caption = Caption =
'Use Transfer: if inpatient will move from one ward or treating t' + 'Use Transfer: if inpatient will move from one ward or treating t' +
'eam to another.' 'eam to another.'
TabOrder = 1
Visible = False
ShowAccelChar = True
end end
end end
end end
object Panel1: TPanel [2] object pnlBottom: TPanel [2]
Left = 0 Left = 0
Top = 134 Top = 116
Width = 456 Width = 456
Height = 217 Height = 235
Align = alClient Align = alClient
TabOrder = 2 TabOrder = 2
ExplicitTop = 112
ExplicitHeight = 239
inline fraEvntDelayList: TfraEvntDelayList inline fraEvntDelayList: TfraEvntDelayList
Left = 1 Left = 1
Top = 1 Top = 1
Width = 454 Width = 454
Height = 215 Height = 233
Align = alClient Align = alClient
AutoScroll = True AutoScroll = True
TabOrder = 0 TabOrder = 0
TabStop = True
Visible = False Visible = False
ExplicitLeft = 1 ExplicitLeft = 1
ExplicitTop = 1 ExplicitTop = 1
ExplicitWidth = 454 ExplicitWidth = 454
ExplicitHeight = 215 ExplicitHeight = 237
inherited pnlDate: TPanel inherited pnlDate: TPanel
Left = 349 Left = 349
Height = 215 Height = 233
ExplicitLeft = 349 ExplicitLeft = 349
ExplicitHeight = 215 ExplicitHeight = 237
inherited lblEffective: TLabel inherited lblEffective: TLabel
Left = 453 Left = 453
Width = 71 Width = 71
@ -189,19 +198,20 @@ inherited frmOrdersTS: TfrmOrdersTS
end end
inherited pnlList: TPanel inherited pnlList: TPanel
Width = 349 Width = 349
Height = 215 Height = 233
ExplicitWidth = 349 ExplicitWidth = 349
ExplicitHeight = 215 ExplicitHeight = 237
inherited lblEvntDelayList: TLabel inherited lblEvntDelayList: TLabel
Width = 347 Width = 347
ExplicitWidth = 80 ExplicitWidth = 80
end end
inherited mlstEvents: TORListBox inherited mlstEvents: TORListBox
Width = 347 Width = 347
Height = 179 Height = 197
OnDblClick = cmdOKClick OnDblClick = cmdOKClick
OnChange = fraEvntDelayListmlstEventsChange
ExplicitWidth = 347 ExplicitWidth = 347
ExplicitHeight = 179 ExplicitHeight = 201
end end
inherited edtSearch: TCaptionEdit inherited edtSearch: TCaptionEdit
Width = 347 Width = 347
@ -237,7 +247,7 @@ inherited frmOrdersTS: TfrmOrdersTS
'Component = pnldif' 'Component = pnldif'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = Panel1' 'Component = pnlBottom'
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = fraEvntDelayList' 'Component = fraEvntDelayList'
@ -259,6 +269,15 @@ inherited frmOrdersTS: TfrmOrdersTS
'Status = stsDefault') 'Status = stsDefault')
( (
'Component = frmOrdersTS' 'Component = frmOrdersTS'
'Status = stsDefault')
(
'Component = lblUseTransfer'
'Status = stsDefault')
(
'Component = lblPtInfo'
'Status = stsDefault')
(
'Component = lblUseAdmit'
'Status = stsDefault')) 'Status = stsDefault'))
end end
end end

21
CPRS-Chart/Orders/fOrdersTS.pas
View File

@ -11,7 +11,7 @@ type
TfrmOrdersTS = class(TfrmAutoSz) TfrmOrdersTS = class(TfrmAutoSz)
pnlMiddle: TPanel; pnlMiddle: TPanel;
pnlTop: TPanel; pnlTop: TPanel;
lblPtInfo: TLabel; lblPtInfo: TVA508StaticText;
grpChoice: TGroupBox; grpChoice: TGroupBox;
radReleaseNow: TRadioButton; radReleaseNow: TRadioButton;
radDelayed: TRadioButton; radDelayed: TRadioButton;
@ -19,9 +19,9 @@ type
Image1: TImage; Image1: TImage;
cmdOK: TButton; cmdOK: TButton;
cmdCancel: TButton; cmdCancel: TButton;
Label1: TLabel; lblUseAdmit: TVA508StaticText;
Label2: TLabel; lblUseTransfer: TVA508StaticText;
Panel1: TPanel; pnlBottom: TPanel;
fraEvntDelayList: TfraEvntDelayList; fraEvntDelayList: TfraEvntDelayList;
procedure cmdOKClick(Sender: TObject); procedure cmdOKClick(Sender: TObject);
procedure cmdCancelClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject);
@ -169,7 +169,9 @@ begin
FCurrSpecialty := ''; FCurrSpecialty := '';
end; end;
procedure TfrmOrdersTS.cmdOKClick(Sender: TObject); procedure TfrmOrdersTS.cmdOKClick(Sender: TObject);
var
tempStr: String;
begin begin
inherited; inherited;
if grpChoice.Tag = 0 then if grpChoice.Tag = 0 then
@ -182,6 +184,15 @@ begin
InfoBox('A release event must be selected.', 'No Selection Made', MB_OK); InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
Exit; Exit;
end; end;
tempStr := fraEvntDelayList.mlstEvents.Items.ValueFromIndex[fraEvntDelayList.mlstEvents.ItemIndex];
if(fraEvntDelayList.mlstEvents.ItemIndex >= 0) and (Length(Piece(tempStr,'^',2))<1)then
begin
InfoBox('Invalid release event selected.', 'No Selection Made', MB_OK);
Exit;
end;
if (fraEvntDelayList.mlstEvents.ItemIndex >= 0) and F1stClick then if (fraEvntDelayList.mlstEvents.ItemIndex >= 0) and F1stClick then
begin begin
fraEvntDelayList.CheckMatch; fraEvntDelayList.CheckMatch;

Some files were not shown because too many files have changed in this diff Show More