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
uses fBALocalDiagnoses, fOrdersSign, fReview, rOrders, uCore, rCore, rPCE,uPCE,
UBAConst, UBAMessages, USignItems;
UBAConst, UBAMessages, USignItems, VAUtils;
// ----------------- MAIN CIDC DX HAS BEEN ENTERED LOGIC ---------------------------

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

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

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

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

30
CPRS-Chart/CPRSChart.bdsproj
View File

@ -5,7 +5,7 @@
<Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType">VCLApplication</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>
</PersonalityInfo>
<Delphi.Personality>
@ -18,7 +18,7 @@
<Compiler>
<Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler>
<Compiler Name="C">1</Compiler>
<Compiler Name="C">0</Compiler>
<Compiler Name="D">1</Compiler>
<Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler>
@ -33,7 +33,7 @@
<Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler>
<Compiler Name="R">1</Compiler>
<Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler>
@ -121,11 +121,11 @@
<Linker Name="ExeDescription"></Linker>
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir">P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\DCU</Directories>
<Directories Name="PackageDLLOutputDir">P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\Packages</Directories>
<Directories Name="PackageDCPOutputDir">P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\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="OutputDir">C:\Vista\cprs\main\CPRS-Chart</Directories>
<Directories Name="UnitOutputDir">C:\Vista\cprs\main\CPRS-Chart\DCU</Directories>
<Directories Name="PackageDLLOutputDir">C:\Vista\cprs\main\Packages</Directories>
<Directories Name="PackageDCPOutputDir">C:\Vista\cprs\main\Packages</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="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
@ -151,8 +151,8 @@
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">27</VersionInfo>
<VersionInfo Name="Build">83</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>
@ -163,15 +163,15 @@
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">Department of Veterans Affairs</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">11/04/2008</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.27.83</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">1.0.27.83 server required</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 304</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.27.83</VersionInfoKeys>
<VersionInfoKeys Name="Comments">Version 1.0.28.24</VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
</BorlandProject>

19
CPRS-Chart/CPRSChart.cfg
View File

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

9
CPRS-Chart/CPRSChart.dpr
View File

@ -7,6 +7,7 @@ program CPRSChart;
uses
ShareMem,
Forms,
WinHelpViewer,
ORSystem,
fPage in 'fPage.pas' {frmPage},
fHSplit in 'fHSplit.pas' {frmHSplit},
@ -314,7 +315,12 @@ uses
fGraphOthers in 'fGraphOthers.pas' {frmGraphOthers},
VA508AccessibilityRouter in '..\VA\VA508Accessibility\VA508AccessibilityRouter.pas',
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}
@ -326,6 +332,7 @@ begin
if not BorlandDLLVersionOK then exit; // Exit immediately if old or missing BORLNDMM.DLL
RegisterCPRSTypeLibrary; // will halt program if /regserver or /unregserver param
Application.Initialize;
frmSplash := nil;
if ParamSearch('SPLASH') <> 'OFF' then
begin

103
CPRS-Chart/CPRSChart.dproj
View File

@ -1,6 +1,6 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{b0a908d8-813b-4a01-b1de-d0c343e41f8b}</ProjectGuid>
<ProjectGuid>{d008760c-d3c7-4922-b5ca-7134478bce35}</ProjectGuid>
<MainSource>CPRSChart.dpr</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
@ -9,88 +9,51 @@
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
<DCC_AssertionsAtRuntime>False</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_WriteableConstants>True</DCC_WriteableConstants>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_RangeChecking>True</DCC_RangeChecking>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_MapFile>3</DCC_MapFile>
<DCC_StackSize>32768,1048576</DCC_StackSize>
<DCC_ExeOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart</DCC_ExeOutput>
<DCC_DcuOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_DcuOutput>
<DCC_ObjOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_ObjOutput>
<DCC_HppOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_HppOutput>
<DCC_BplOutput>C:\Vista\cprs\OR_3_243V27\Packages</DCC_BplOutput>
<DCC_DcpOutput>C:\Vista\cprs\OR_3_243V27\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_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>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>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_ExeOutput>C:\Vista\cprs\main\CPRS-Chart</DCC_ExeOutput>
<DCC_DcuOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_DcuOutput>
<DCC_ObjOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_ObjOutput>
<DCC_HppOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_HppOutput>
<DCC_BplOutput>C:\Vista\cprs\main\Packages</DCC_BplOutput>
<DCC_DcpOutput>C:\Vista\cprs\main\Packages</DCC_DcpOutput>
<DCC_UnitSearchPath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_UnitSearchPath>
<DCC_ResourcePath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_ResourcePath>
<DCC_ObjPath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_ObjPath>
<DCC_IncludePath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_IncludePath>
<DCC_Define>RELEASE</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_AssertionsAtRuntime>False</DCC_AssertionsAtRuntime>
<DCC_WriteableConstants>True</DCC_WriteableConstants>
<DCC_RangeChecking>True</DCC_RangeChecking>
<DCC_MapFile>3</DCC_MapFile>
<DCC_StackSize>32768,1048576</DCC_StackSize>
<DCC_ExeOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart</DCC_ExeOutput>
<DCC_DcuOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_DcuOutput>
<DCC_ObjOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_ObjOutput>
<DCC_HppOutput>C:\Vista\cprs\OR_3_243V27\CPRS-chart\DCU</DCC_HppOutput>
<DCC_BplOutput>C:\Vista\cprs\OR_3_243V27\Packages</DCC_BplOutput>
<DCC_DcpOutput>C:\Vista\cprs\OR_3_243V27\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_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>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>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_DcuOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_DcuOutput>
<DCC_ObjOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_ObjOutput>
<DCC_HppOutput>C:\Vista\cprs\main\CPRS-Chart\DCU</DCC_HppOutput>
<DCC_BplOutput>C:\Vista\cprs\main\Packages</DCC_BplOutput>
<DCC_DcpOutput>C:\Vista\cprs\main\Packages</DCC_DcpOutput>
<DCC_UnitSearchPath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_UnitSearchPath>
<DCC_ResourcePath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_ResourcePath>
<DCC_ObjPath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_ObjPath>
<DCC_IncludePath>..\cprs-chart;C:\Vista\cprs\main\CPRS-Lib;..\va;C:\Vista\cprs\main\VA\VA508Accessibility</DCC_IncludePath>
<DCC_Define>DEBUG</DCC_Define>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
<BorlandProject xmlns=""> <Delphi.Personality> <Parameters>
<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>
<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>
</ProjectExtensions>
<ItemGroup />
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="CPRSChart.dpr">
<MainSource>MainSource</MainSource>
@ -276,6 +239,9 @@
<DCCReference Include="fClinicWardMeds.pas">
<Form>frmClinicWardMeds</Form>
</DCCReference>
<DCCReference Include="fCombatVet.pas">
<Form>frmCombatVet</Form>
</DCCReference>
<DCCReference Include="fCover.pas">
<Form>frmCover</Form>
</DCCReference>
@ -330,6 +296,9 @@
<DCCReference Include="fHSplit.pas">
<Form>frmHSplit</Form>
</DCCReference>
<DCCReference Include="fHunSpell.pas">
<Form>frmHunSpell</Form>
</DCCReference>
<DCCReference Include="fIconLegend.pas">
<Form>frmIconLegend</Form>
</DCCReference>
@ -498,6 +467,9 @@
<DCCReference Include="fSignItem.pas">
<Form>frmSignItem</Form>
</DCCReference>
<DCCReference Include="fSpellNotify.pas">
<Form>frmSpellNotify</Form>
</DCCReference>
<DCCReference Include="fSplash.pas">
<Form>frmSplash</Form>
</DCCReference>
@ -599,6 +571,9 @@
<DCCReference Include="Orders\fOCAccept.pas">
<Form>frmOCAccept</Form>
</DCCReference>
<DCCReference Include="Orders\fOCMonograph.pas">
<Form>frmOCMonograph</Form>
</DCCReference>
<DCCReference Include="Orders\fOCSession.pas">
<Form>frmOCSession</Form>
</DCCReference>
@ -847,6 +822,7 @@
<DCCReference Include="Templates\uTemplateFields.pas" />
<DCCReference Include="Templates\uTemplates.pas" />
<DCCReference Include="uCaseTree.pas" />
<DCCReference Include="uCombatVet.pas" />
<DCCReference Include="uConst.pas" />
<DCCReference Include="uCore.pas" />
<DCCReference Include="uDCSumm.pas" />
@ -873,5 +849,4 @@
<DCCReference Include="Vitals\uVitals.pas" />
<DCCReference Include="XuDigSigSC_TLB.pas" />
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
</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]
File_0=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\fFrame.pas',0,1,3475,6,3476,0,0,,
File_1=TSourceModule,'C:\Program Files\vista\BDK32\Source\wsockc.pas',0,1,1464,1,1485,0,0,,
File_2=TSourceModule,'C:\Vista\cprs\OR_3_243V27\VA\VAUtils.pas',0,1,1390,1,1407,0,0,,
File_3=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\fReports.pas',0,1,245,1,266,0,0,,
File_4=TSourceModule,'C:\Vista\cprs\OR_3_243V27\VA\VA508Accessibility\VA508AccessibilityManager.pas',0,1,1163,1,1184,0,0,,
File_5=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\uGraphs.pas',0,1,199,1,220,0,0,,
File_6=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\VERGENCECONTEXTORLib_TLB.pas',0,1,1104,47,1117,0,0,,
File_7=TSourceModule,'C:\Vista\cprs\OR_3_243V27\CPRS-chart\Orders\fOrdersDC.pas',0,1,98,51,121,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_9=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fAutoSz.pas',0,1,1,1,1,0,0,,
File_0=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fAllgyBox.pas',0,1,102,1,1,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\main\CPRS-Chart\fFrame.pas',0,1,37,1,1,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\main\CPRS-Chart\fNotes.pas',0,1,2877,14,2880,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\main\CPRS-Lib\ORNet.pas',0,1,1,25,2,0,0,,
File_7=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\uSpell.pas',0,1,7,26,12,0,0,,
File_8=TSourceModule,'C:\Vista\cprs\main\CPRS-Chart\fARTAllgy.pas',0,1,7,3,7,0,0,,
[Modules]
Module0=default.htm
Count=1
Module0=C:\Vista\cprs\main\CPRS-Chart\CPRSChart.bdsproj
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
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]
ModuleType=TURLModule
[C:\Vista\cprs\main\CPRS-Chart\fBase508Form.pas]
FormState=0
FormOnTop=0
[EditWindow0]
ViewCount=1
CurrentView=0
ViewCount=6
CurrentEditView=C:\Vista\cprs\main\CPRS-Chart\CPRSChart.dpr
View0=0
View1=1
View2=2
View3=3
View4=4
View5=5
PercentageSizes=1
Create=1
Visible=1
Docked=0
State=0
Left=3154
Top=1192
Left=1709
Top=1131
Width=6797
Height=8767
Height=8760
MaxLeft=0
MaxTop=0
ClientWidth=6719
ClientHeight=8306
ClientHeight=8297
DockedToMainForm=0
MessageView=MessageView@EditWindow0
BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0
@ -44,19 +80,74 @@ LeftPanelSize=0
LeftPanelClients=BorlandEditorCodeExplorer@EditWindow0
LeftPanelData=0000080001000100000019000000426F726C616E64456469746F72436F64654578706C6F726572B70C00000000000000E201000000000000FFFFFFFF
RightPanelSize=0
BottomPanelSize=0
BottomPanelSize=3125
BottomPanelClients=MessageView@EditWindow0
BottomPanelData=000008000100010000000B0000004D657373616765566965770000000000000000000000000000000000FFFFFFFF
BottomPanelData=0000080001000000000000000000000000000000000000000000000100000000000000000B0000004D65737361676556696577FFFFFFFF
BottomMiddlePanelSize=0
BottomMiddlePanelClients=DockSite1
BottomMiddelPanelData=0000080001000100000009000000446F636B53697465310000000000000000000000000000000000FFFFFFFF
BottomMiddlePanelClients=DockSite0
BottomMiddelPanelData=0000080001000100000009000000446F636B53697465300000000000000000000000000000000000FFFFFFFF
[View0]
CustomEditViewType=TWelcomePageView
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]
Module=P:\vista\CPRS-WV_OFFICIAL_RELEASE-27\WVEHR-v27Delphi2006\CPRS-chart\CPRSChart.tlb
Module=C:\Vista\cprs\main\CPRS-Chart\CPRSChart.tlb
[Watches]
Count=0
@ -70,13 +161,13 @@ Visible=0
Docked=0
State=0
Left=1738
Top=1423
Top=1417
Width=2627
Height=2344
Height=2343
MaxLeft=-10
MaxTop=-14
ClientWidth=2549
ClientHeight=1992
ClientHeight=1989
TBDockHeight=163
LRDockWidth=2549
Dockable=1
@ -84,7 +175,7 @@ StayOnTop=0
[Breakpoints]
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]
Count=0
@ -98,11 +189,11 @@ State=0
Left=0
Top=0
Width=10000
Height=1165
Height=1172
MaxLeft=-10
MaxTop=-14
ClientWidth=9922
ClientHeight=705
ClientHeight=708
BottomPanelSize=0
[ProjectManager]
@ -114,12 +205,12 @@ State=0
Left=0
Top=0
Width=1289
Height=2358
Height=2357
MaxLeft=-1
MaxTop=-1
ClientWidth=1289
ClientHeight=2358
TBDockHeight=271
ClientHeight=2357
TBDockHeight=272
LRDockWidth=3730
Dockable=1
StayOnTop=0
@ -128,17 +219,17 @@ StayOnTop=0
PercentageSizes=1
Create=1
Visible=1
Docked=1
Docked=0
State=0
Left=0
Top=0
Width=2920
Height=7696
MaxLeft=-1
MaxTop=-1
ClientWidth=2920
ClientHeight=7696
TBDockHeight=5813
Left=8506
Top=4292
Width=1475
Height=5613
MaxLeft=-10
MaxTop=-14
ClientWidth=1396
ClientHeight=5259
TBDockHeight=5817
LRDockWidth=1406
Dockable=1
StayOnTop=0
@ -150,14 +241,14 @@ Visible=0
Docked=0
State=0
Left=68
Top=8198
Top=8202
Width=3623
Height=3360
Height=3365
MaxLeft=-10
MaxTop=-14
ClientWidth=3545
ClientHeight=3008
TBDockHeight=298
ClientHeight=3011
TBDockHeight=300
LRDockWidth=3623
Dockable=1
StayOnTop=0
@ -169,14 +260,14 @@ Visible=0
Docked=0
State=0
Left=68
Top=8198
Top=8202
Width=5420
Height=1762
Height=1757
MaxLeft=-10
MaxTop=-14
ClientWidth=5342
ClientHeight=1409
TBDockHeight=149
ClientHeight=1403
TBDockHeight=150
LRDockWidth=5420
Dockable=1
StayOnTop=0
@ -192,14 +283,14 @@ Visible=0
Docked=0
State=0
Left=1738
Top=1423
Top=1417
Width=2627
Height=2412
Height=2411
MaxLeft=-10
MaxTop=-14
ClientWidth=2549
ClientHeight=2060
TBDockHeight=203
ClientHeight=2057
TBDockHeight=204
LRDockWidth=2549
Dockable=1
StayOnTop=0
@ -211,13 +302,13 @@ Visible=0
Docked=0
State=0
Left=117
Top=1558
Top=1553
Width=2627
Height=2344
Height=2343
MaxLeft=-10
MaxTop=-14
ClientWidth=2549
ClientHeight=1992
ClientHeight=1989
TBDockHeight=163
LRDockWidth=2549
Dockable=1
@ -232,12 +323,12 @@ State=0
Left=0
Top=0
Width=4307
Height=1396
Height=1390
MaxLeft=-1
MaxTop=-1
ClientWidth=4307
ClientHeight=1396
TBDockHeight=5081
ClientHeight=1390
TBDockHeight=5082
LRDockWidth=5303
Dockable=1
StayOnTop=0
@ -251,12 +342,12 @@ State=0
Left=0
Top=0
Width=4307
Height=1396
Height=1390
MaxLeft=-1
MaxTop=-1
ClientWidth=4307
ClientHeight=1396
TBDockHeight=3835
ClientHeight=1390
TBDockHeight=3828
LRDockWidth=5303
Dockable=1
StayOnTop=0
@ -270,12 +361,12 @@ State=0
Left=0
Top=0
Width=4297
Height=5827
Height=5858
MaxLeft=-10
MaxTop=-14
ClientWidth=4219
ClientHeight=5474
TBDockHeight=5827
ClientHeight=5504
TBDockHeight=5858
LRDockWidth=4297
Dockable=1
StayOnTop=0
@ -292,31 +383,51 @@ State=0
Left=0
Top=0
Width=1289
Height=2358
Height=2357
MaxLeft=-1
MaxTop=-1
ClientWidth=1289
ClientHeight=2358
TBDockHeight=4878
ClientHeight=2357
TBDockHeight=4877
LRDockWidth=7148
Dockable=1
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]
PercentageSizes=1
Create=1
Visible=0
Docked=1
State=0
Left=-183
Top=-748
Left=-541
Top=-1945
Width=5303
Height=3835
Height=3828
MaxLeft=-1
MaxTop=-1
ClientWidth=5303
ClientHeight=3835
TBDockHeight=3835
ClientHeight=3828
TBDockHeight=3828
LRDockWidth=5303
Dockable=1
StayOnTop=0
@ -327,15 +438,15 @@ Create=1
Visible=0
Docked=1
State=0
Left=-183
Top=-748
Left=-541
Top=-1945
Width=5303
Height=3835
Height=3828
MaxLeft=-1
MaxTop=-1
ClientWidth=5303
ClientHeight=3835
TBDockHeight=3835
ClientHeight=3828
TBDockHeight=3828
LRDockWidth=5303
Dockable=1
StayOnTop=0
@ -346,15 +457,15 @@ Create=1
Visible=0
Docked=1
State=0
Left=-183
Top=-748
Left=-541
Top=-1945
Width=5303
Height=3835
Height=3828
MaxLeft=-1
MaxTop=-1
ClientWidth=5303
ClientHeight=3835
TBDockHeight=3835
ClientHeight=3828
TBDockHeight=3828
LRDockWidth=5303
Dockable=1
StayOnTop=0
@ -365,15 +476,15 @@ Create=1
Visible=0
Docked=1
State=0
Left=-183
Top=-748
Left=-541
Top=-1945
Width=5303
Height=3835
Height=3828
MaxLeft=-1
MaxTop=-1
ClientWidth=5303
ClientHeight=3835
TBDockHeight=3835
ClientHeight=3828
TBDockHeight=3828
LRDockWidth=5303
Dockable=1
StayOnTop=0
@ -387,36 +498,16 @@ State=0
Left=0
Top=0
Width=1289
Height=2358
Height=2357
MaxLeft=-1
MaxTop=-1
ClientWidth=1289
ClientHeight=2358
TBDockHeight=4878
ClientHeight=2357
TBDockHeight=4877
LRDockWidth=5303
Dockable=1
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]
PercentageSizes=1
Create=1
@ -424,14 +515,14 @@ Visible=0
Docked=0
State=0
Left=88
Top=7453
Top=7452
Width=6396
Height=2276
Height=2275
MaxLeft=-10
MaxTop=-14
ClientWidth=6318
ClientHeight=1924
TBDockHeight=203
ClientHeight=1921
TBDockHeight=204
LRDockWidth=6396
Dockable=1
StayOnTop=0
@ -445,18 +536,18 @@ Column5Width=75
[StructureView]
PercentageSizes=1
Create=1
Visible=0
Visible=1
Docked=0
State=0
Left=0
Top=1192
Top=1185
Width=1670
Height=3469
Height=3474
MaxLeft=-10
MaxTop=-14
ClientWidth=1592
ClientHeight=3117
TBDockHeight=3469
ClientHeight=3120
TBDockHeight=3474
LRDockWidth=1670
Dockable=1
StayOnTop=0
@ -468,14 +559,14 @@ Visible=0
Docked=0
State=0
Left=78
Top=7656
Top=7657
Width=9863
Height=2209
Height=2207
MaxLeft=-10
MaxTop=-14
ClientWidth=9785
ClientHeight=1856
TBDockHeight=1098
ClientHeight=1853
TBDockHeight=1104
LRDockWidth=1504
Dockable=1
StayOnTop=0
@ -483,18 +574,18 @@ StayOnTop=0
[MessageView@EditWindow0]
PercentageSizes=1
Create=1
Visible=0
Visible=1
Docked=1
State=0
Left=-179
Top=-726
Width=2773
Height=1152
Left=0
Top=23
Width=6719
Height=2956
MaxLeft=-1
MaxTop=-1
ClientWidth=2773
ClientHeight=1152
TBDockHeight=1152
ClientWidth=6719
ClientHeight=2956
TBDockHeight=2956
LRDockWidth=2773
Dockable=1
StayOnTop=0
@ -508,58 +599,35 @@ State=0
Left=-179
Top=-113
Width=1465
Height=8266
Height=8270
MaxLeft=-1
MaxTop=-1
ClientWidth=1465
ClientHeight=8266
TBDockHeight=8266
ClientHeight=8270
TBDockHeight=8270
LRDockWidth=1465
Dockable=1
StayOnTop=0
[DockHosts]
DockHostCount=3
DockHostCount=2
[DockSite0]
DockSiteType=1
PercentageSizes=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
Docked=1
State=0
Left=-179
Top=-726
Left=693
Top=-396
Width=4385
Height=1870
Height=1866
MaxLeft=-1
MaxTop=-1
ClientWidth=4385
ClientHeight=1870
TBDockHeight=1870
ClientHeight=1866
TBDockHeight=1866
LRDockWidth=4385
Dockable=1
StayOnTop=0
@ -567,22 +635,22 @@ TabPosition=1
ActiveTabID=RefactoringForm
TabDockClients=RefactoringForm,FindReferencsForm,UsagesView,RefactoringsView,QAView,MetricsView
[DockSite2]
[DockSite1]
DockSiteType=1
PercentageSizes=1
Create=1
Visible=0
Visible=1
Docked=0
State=0
Left=8516
Top=1125
Top=1131
Width=1445
Height=3184
Height=3188
MaxLeft=-10
MaxTop=-14
ClientWidth=1367
ClientHeight=2832
TBDockHeight=3184
ClientHeight=2834
TBDockHeight=3188
LRDockWidth=1445
Dockable=1
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.
// ************************************************************************ //
// PASTLWTR : 1.2
// File generated on 6/26/2010 8:43:12 PM from Type Library described below.
// $Rev: 8291 $
// 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}
// LCID: 0
// Helpfile:

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

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

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

@ -152,11 +152,15 @@ function TfrmConsultAction.SetupForward(IsProcedure: boolean; ProcIEN: integer):
var
i: integer;
OrdItmIEN: integer;
attention: string; //wat cq 15561
AList: TStringList; {WAT cq 19626}
begin
pnlSigFind.Visible := False;
with frmConsultAction do Height := Height - pnlSigFind.Height;
pnlComments.Visible := True;
memComments.Clear;
AList := TStringList.Create;
try {WAT cq 19626}
if IsProcedure then
begin
OrdItmIEN := GetOrderableIEN(IntToStr(ConsultRec.ORFileNumber));
@ -182,7 +186,9 @@ begin
end
else
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
if (cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1) and {RV}
(Piece(SvcList.Strings[i], U, 5) <> '1') then
@ -203,7 +209,13 @@ begin
end ;
if cboService.Items.Count = 1 then cboService.ItemIndex := 0;
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
begin
FastAssign(SubsetofUrgencies(ConsultRec.IEN), cboUrgency.Items) ;
@ -227,6 +239,9 @@ begin
ckAlert.Visible := False ;
lblAutoAlerts.Visible := False;
Result := True;
finally
AList.Free; {WAT cq 19626}
end;
end;
procedure TfrmConsultAction.SetupAddComment;

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

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

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

@ -179,6 +179,7 @@ type
imgLblNotes: TVA508ImageListLabeler;
imgLblImages: TVA508ImageListLabeler;
imgLblConsults: TVA508ImageListLabeler;
popNoteMemoViewCslt: TMenuItem; //wat cq 17586
procedure mnuChartTabClick(Sender: TObject);
procedure lstConsultsClick(Sender: TObject);
procedure pnlRightResize(Sender: TObject);
@ -284,6 +285,7 @@ type
procedure pnlRightExit(Sender: TObject);
procedure cmdEditResubmitExit(Sender: TObject);
procedure cmdNewConsultExit(Sender: TObject);
procedure popNoteMemoViewCsltClick(Sender: TObject); //wat cq 17586
private
FocusToRightPanel : Boolean;
FEditingIndex: Integer; // TIU index of document being currently edited
@ -347,6 +349,8 @@ type
procedure DoAttachIDChild(AChild, AParent: TORTreeNode);
function UserIsSigner(NoteIEN: integer): boolean;
public
function CustomCanFocus(Control: TWinControl): Boolean; //CB
function LinesVisible(richedit: Trichedit): integer; //CB
function ActiveEditOf(AnIEN: Int64): Boolean;
function AllowContextChange(var WhyNot: string): Boolean; override;
procedure ClearPtData; override;
@ -364,6 +368,7 @@ type
property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published
end;
var
frmConsults: TfrmConsults;
@ -637,8 +642,9 @@ begin
FCurrentContext := AContext;
CurrNotifIEN := 0;
EditingIndex := -1;
tvConsults.Enabled := True;
lstConsults.Enabled := True ;
pnlConsultList.Enabled := True; //CQ#15785
// tvConsults.Enabled := True;
// lstConsults.Enabled := True ;
lstNotes.Enabled := True ;
pnlRead.BringToFront ;
memConsult.TabStop := True;
@ -768,8 +774,9 @@ begin
TmpBoilerPlate := nil;
try
ClearEditControls;
tvConsults.Enabled := False;
lstConsults.Enabled := False ;
pnlConsultList.Enabled := False; //CQ#15785
// tvConsults.Enabled := False;
// lstConsults.Enabled := False ;
FillChar(FEditNote, SizeOf(FEditNote), 0); //v15.7
with FEditNote do
begin
@ -898,8 +905,9 @@ begin
if not HaveRequired then
begin
ClearEditControls;
lstConsults.Enabled := True;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True;
// tvConsults.Enabled := True;
end;
SetResultMenus ;
finally
@ -929,8 +937,9 @@ var
begin
AClassName := DCL_CONSULTS;
ClearEditControls;
lstConsults.Enabled := False ;
tvConsults.Enabled := False;
pnlConsultList.Enabled := False; //CQ#15785
// lstConsults.Enabled := False ;
// tvConsults.Enabled := False;
with FEditNote do
begin
DocType := TYP_ADDENDUM;
@ -1007,8 +1016,9 @@ begin
//if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult);
InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
HaveRequired := False;
lstConsults.Enabled := True;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True;
// tvConsults.Enabled := True;
end; {if CreatedNote.IEN}
end; {if HaveRequired}
if not HaveRequired then ClearEditControls;
@ -1558,6 +1568,26 @@ begin
else if NoteIEN = -1 then Exit
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);
const
IS_ID_CHILD = True;
@ -1791,8 +1821,9 @@ begin
cmdPCE.Visible := FALSE;
popNoteMemoEncounter.Visible := FALSE;
UpdateList;
lstConsults.Enabled := True ;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
with tvConsults do Selected := FindPieceNode(IntToStr(SaveConsult), 1, U, Items.GetFirstNode);
tvConsultsClick(Self);
(* lstConsults.SelectByIEN(ConsultRec.IEN);
@ -1850,8 +1881,9 @@ begin
begin
pnlResults.Visible := False;
pnlResults.SendToBack;
lstConsults.Enabled := True;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True;
// tvConsults.Enabled := True;
if Notifications.Active then
with tvConsults do
begin
@ -1970,8 +2002,9 @@ begin
begin
pnlResults.Visible := False;
pnlResults.SendToBack;
lstConsults.Enabled := True;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True;
// tvConsults.Enabled := True;
if Notifications.Active then
with tvConsults do
begin
@ -2181,8 +2214,9 @@ begin
FActionType := TMenuItem(Sender).Tag ;
ClearEditControls ;
lstNotes.Enabled := False ;
lstConsults.Enabled := False ;
tvConsults.Enabled := False;
pnlConsultList.Enabled := False; //CQ#15785
// lstConsults.Enabled := False ;
// tvConsults.Enabled := False;
x := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 12);
if x <> '' then
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, lstConsults.ItemIEN);
lstNotes.Enabled := True ;
lstConsults.Enabled := True ;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
end;
procedure TfrmConsults.UpdateList;
@ -2395,7 +2430,6 @@ begin
(MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
(MenuAccessRec.UserLevel = UL_UNRESTRICTED))
and
(ConsultRec.ORStatus=ST_COMPLETE) and
((lstNotes.ItemIndex > -1) and
((ConsultRec.TIUResultNarrative>0) or
(lstNotes.ItemIEN > 0)));
@ -2624,8 +2658,9 @@ begin
with lstNotes do
if ItemIndex = EditingIndex then
begin
lstConsults.Enabled := False ;
tvConsults.Enabled := False;
pnlConsultList.Enabled := False; //CQ#15785
// lstConsults.Enabled := False ;
// tvConsults.Enabled := False;
pnlResults.Visible := True;
pnlResults.BringToFront;
memConsult.TabStop := False;
@ -2638,8 +2673,9 @@ begin
StatusText('Retrieving selected item...');
if EditingIndex = -1 then
begin
lstConsults.Enabled := True ;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
end;
lblTitle.Caption := MakeConsultNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]);
lblTitle.Hint := lblTitle.Caption;
@ -2709,6 +2745,7 @@ begin
popNoteMemoReplace.Enabled := (FEditCtrl.GetTextLen > 0);
popNoteMemoPreview.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
begin
popNoteMemoSpell.Enabled := False;
@ -2717,6 +2754,7 @@ begin
popNoteMemoReplace.Enabled := False;
popNoteMemoPreview.Enabled := False;
popNoteMemoInsTemplate.Enabled := False;
popNoteMemoViewCslt.Enabled := FALSE; //wat cq 17586
end;
end;
@ -2837,21 +2875,27 @@ begin
end;
end;
{for printing multiple notes}
procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList);
var
NoteIEN: int64;
i: integer;
begin
inherited;
with AForm.lbIDParents do
begin
for i := 0 to Items.Count - 1 do
begin
if Selected[i] then
begin
NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0);
if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i])
else if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK)
else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
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;
procedure TfrmConsults.mnuActDisplayResultsClick(Sender: TObject);
@ -3103,6 +3147,10 @@ var
Saved: boolean;
AnObject: PDocTreeObject;
tmpNode: TORTreeNode;
I:Integer;
CommentDate: String;
Format: CHARFORMAT2;
VisibleLineCount: integer;
begin
if EditingIndex <> -1 then
begin
@ -3115,8 +3163,9 @@ begin
lblConsults.Caption := Notifications.Text;
tvConsults.Caption := Notifications.Text;
EditingIndex := -1;
lstConsults.Enabled := True ;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
lstNotes.Enabled := True ;
pnlRead.BringToFront ;
memConsult.TabStop := True;
@ -3203,9 +3252,40 @@ begin
end;
tvCsltNotesChange(Self, tvCsltNotes.Selected);
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);
//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
NF_CONSULT_REQUEST_RESOLUTION : Notifications.Delete;
NF_NEW_SERVICE_CONSULT_REQUEST : Notifications.Delete;
@ -3221,6 +3301,53 @@ begin
FNotifPending := False;
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);
var
Resubmitted: boolean;
@ -3947,8 +4074,9 @@ begin
AConsult := ItemIEN;
if not LockConsultRequest(AConsult) then Exit;
lstNotes.Enabled := False ;
lstConsults.Enabled := False ;
tvConsults.Enabled := False;
pnlConsultList.Enabled := False; //CQ#15785
// lstConsults.Enabled := False ;
// tvConsults.Enabled := False;
if ActionType = 'ATTACH' then
begin
FormTitle := TX_ATTACH + Piece(DisplayText[ItemIndex], #9, 3);
@ -3979,8 +4107,9 @@ begin
end;
end;
lstNotes.Enabled := True ;
lstConsults.Enabled := True ;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
FOrderID := GetConsultOrderIEN(AConsult);
UnlockOrderIfAble(FOrderID);
FOrderID := '';
@ -4067,8 +4196,9 @@ begin
frmDrawers.DisplayDrawers(FALSE);
cmdPCE.Visible := FALSE;
popNoteMemoEncounter.Visible := FALSE;
lstConsults.Enabled := True ;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
lstNotes.Enabled := True;
lblTitle.Caption := '';
lblTitle.Hint := lblTitle.Caption;
@ -4434,8 +4564,9 @@ begin
end;
popNoteListExpandSelected.Enabled := Selected.HasChildren;
popNoteListCollapseSelected.Enabled := Selected.HasChildren;
lstConsults.Enabled := True ;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
lstNotes.Enabled := True;
if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
begin
@ -4449,8 +4580,9 @@ begin
frmDrawers.DisplayDrawers(FALSE);
cmdPCE.Visible := FALSE;
popNoteMemoEncounter.Visible := FALSE;
lstConsults.Enabled := True ;
tvConsults.Enabled := True;
pnlConsultList.Enabled := True; //CQ#15785
// lstConsults.Enabled := True ;
// tvConsults.Enabled := True;
KillDocTreeObjects(tvCsltNotes);
tvCsltNotes.Items.Clear;
lstNotes.Clear;

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

@ -1,126 +1,61 @@
inherited frmEditCslt: TfrmEditCslt
Tag = 110
Left = 409
Top = 225
Width = 599
Height = 375
Left = 461
Top = 191
Width = 576
Height = 479
HorzScrollBar.Range = 561
VertScrollBar.Range = 340
Caption = 'Edit/Resubmit a Cancelled Consult'
Constraints.MinHeight = 371
Constraints.MinWidth = 573
Constraints.MinHeight = 467
Constraints.MinWidth = 576
OldCreateOrder = True
Position = poScreenCenter
ExplicitLeft = 409
ExplicitTop = 225
ExplicitWidth = 599
ExplicitHeight = 375
ExplicitWidth = 576
ExplicitHeight = 479
DesignSize = (
591
341)
568
448)
PixelsPerInch = 96
TextHeight = 13
object lblService: TLabel [0]
Left = 4
Top = 4
Width = 134
Height = 13
Caption = 'Consult to Service/Specialty'
end
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]
object pnlCombatVet: TPanel [0]
Left = 0
Top = 0
Width = 568
Height = 25
Align = alTop
BevelOuter = bvLowered
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
PopupMenu = popReason
ScrollBars = ssBoth
TabOrder = 11
WantTabs = True
OnChange = ControlChange
OnExit = memReasonExit
OnKeyDown = memCommentKeyDown
OnKeyPress = memCommentKeyPress
OnKeyUp = memCommentKeyUp
ExplicitHeight = 136
TabOrder = 0
object txtCombatVet: TVA508StaticText
Name = 'txtCombatVet'
Left = 1
Top = 1
Width = 566
Height = 23
Align = alClient
Alignment = taCenter
BevelOuter = bvNone
Enabled = False
TabOrder = 0
ShowAccelChar = True
end
object pnlMessage: TPanel [10]
Left = 16
Top = 294
Width = 418
end
object pnlMessage: TPanel [1]
Left = 21
Top = 404
Width = 388
Height = 44
Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised
BorderStyle = bsSingle
Caption = 'pnlMessage'
TabOrder = 15
TabOrder = 4
Visible = False
object imgMessage: TImage
Left = 4
@ -145,12 +80,134 @@ inherited frmEditCslt: TfrmEditCslt
WantReturns = False
end
end
object cboService: TORComboBox [11]
object cmdAccept: TButton [2]
Left = 414
Top = 425
Width = 72
Height = 21
Anchors = [akRight, akBottom]
Caption = 'Resubmit'
TabOrder = 2
OnClick = cmdAcceptClick
end
object cmdQuit: TButton [3]
Left = 491
Top = 425
Width = 72
Height = 21
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
TabOrder = 3
OnClick = cmdQuitClick
end
object pnlMain: TPanel [4]
Left = 0
Top = 0
Width = 569
Height = 402
Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone
TabOrder = 1
DesignSize = (
569
402)
object lblService: TLabel
Left = 4
Top = 4
Width = 134
Height = 13
Caption = 'Consult to Service/Specialty'
end
object lblReason: TLabel
Left = 4
Top = 227
Width = 95
Height = 13
Caption = 'Reason for Request'
end
object lblComment: TLabel
Left = 4
Top = 169
Width = 77
Height = 13
Caption = 'New Comments:'
end
object lblComments: TLabel
Left = 8
Top = 108
Width = 89
Height = 13
Caption = 'Display Comments:'
end
object lblUrgency: TStaticText
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 = 21
Style = orcsDropDown
Height = 83
Style = orcsSimple
AutoSelect = True
Caption = 'Consult to Service/Specialty'
Color = clWindow
@ -175,7 +232,7 @@ inherited frmEditCslt: TfrmEditCslt
TabOrder = 0
CharsNeedMatch = 1
end
object cboUrgency: TORComboBox [12]
object cboUrgency: TORComboBox
Left = 196
Top = 19
Width = 170
@ -199,28 +256,28 @@ inherited frmEditCslt: TfrmEditCslt
OnChange = ControlChange
CharsNeedMatch = 1
end
object radInpatient: TRadioButton [13]
object radInpatient: TRadioButton
Left = 197
Top = 61
Top = 113
Width = 61
Height = 17
Caption = '&Inpatient'
TabOrder = 5
TabOrder = 6
OnClick = radInpatientClick
end
object radOutpatient: TRadioButton [14]
object radOutpatient: TRadioButton
Left = 269
Top = 61
Top = 113
Width = 73
Height = 17
Caption = '&Outpatient'
TabOrder = 6
TabOrder = 7
OnClick = radOutpatientClick
end
object cboPlace: TORComboBox [15]
object cboPlace: TORComboBox
Left = 376
Top = 54
Width = 216
Top = 106
Width = 188
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
@ -238,28 +295,28 @@ inherited frmEditCslt: TfrmEditCslt
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 7
TabOrder = 8
OnChange = ControlChange
CharsNeedMatch = 1
end
object txtProvDiag: TCaptionEdit [16]
object txtProvDiag: TCaptionEdit
Left = 195
Top = 95
Width = 346
Top = 147
Width = 316
Height = 21
Anchors = [akLeft, akTop, akRight]
MaxLength = 180
ParentShowHint = False
PopupMenu = mnuPopProvDx
ShowHint = True
TabOrder = 8
TabOrder = 10
OnChange = ControlChange
Caption = 'Provisional Diagnosis'
end
object txtAttn: TORComboBox [17]
object txtAttn: TORComboBox
Left = 376
Top = 19
Width = 218
Width = 188
Height = 21
Anchors = [akLeft, akTop, akRight]
Style = orcsDropDown
@ -282,8 +339,8 @@ inherited frmEditCslt: TfrmEditCslt
OnNeedData = txtAttnNeedData
CharsNeedMatch = 1
end
object cboCategory: TORComboBox [18]
Left = 561
object cboCategory: TORComboBox
Left = 559
Top = 103
Width = 10
Height = 21
@ -300,66 +357,46 @@ inherited frmEditCslt: TfrmEditCslt
MaxLength = 0
Sorted = False
SynonymChars = '<>'
TabOrder = 14
TabOrder = 13
Visible = False
CharsNeedMatch = 1
end
object cmdAccept: TButton [19]
Left = 437
Top = 319
Width = 72
Height = 21
Anchors = [akRight, akBottom]
Caption = 'Resubmit'
TabOrder = 12
OnClick = cmdAcceptClick
end
object cmdQuit: TButton [20]
Left = 514
Top = 319
Width = 72
Height = 21
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
TabOrder = 13
OnClick = cmdQuitClick
end
object memComment: TRichEdit [21]
object memComment: TRichEdit
Left = 4
Top = 121
Width = 587
Top = 185
Width = 557
Height = 41
Anchors = [akLeft, akTop, akRight]
PopupMenu = popReason
TabOrder = 10
TabOrder = 11
WantTabs = True
OnChange = ControlChange
OnExit = memCommentExit
OnKeyDown = memCommentKeyDown
OnKeyPress = memCommentKeyPress
OnKeyUp = memCommentKeyUp
end
object btnCmtCancel: TButton [22]
Left = 110
Top = 49
object btnCmtCancel: TButton
Left = 8
Top = 127
Width = 75
Height = 21
Caption = 'Cancellation'
TabOrder = 3
TabOrder = 4
OnClick = btnCmtCancelClick
end
object btnCmtOther: TButton [23]
object btnCmtOther: TButton
Left = 110
Top = 75
Top = 127
Width = 75
Height = 21
Caption = 'Other'
TabOrder = 4
TabOrder = 5
OnClick = btnCmtOtherClick
end
object cmdLexSearch: TButton [24]
Left = 545
Top = 95
object cmdLexSearch: TButton
Left = 515
Top = 147
Width = 46
Height = 21
Anchors = [akTop, akRight]
@ -367,8 +404,66 @@ inherited frmEditCslt: TfrmEditCslt
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
inherited amgrMain: TVA508AccessibilityManager
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'
'Status = stsDefault')
@ -387,12 +482,6 @@ inherited frmEditCslt: TfrmEditCslt
(
'Component = memReason'
'Status = stsDefault')
(
'Component = pnlMessage'
'Status = stsDefault')
(
'Component = memMessage'
'Status = stsDefault')
(
'Component = cboService'
'Status = stsDefault')
@ -417,12 +506,6 @@ inherited frmEditCslt: TfrmEditCslt
(
'Component = cboCategory'
'Status = stsDefault')
(
'Component = cmdAccept'
'Status = stsDefault')
(
'Component = cmdQuit'
'Status = stsDefault')
(
'Component = memComment'
'Status = stsDefault')
@ -436,12 +519,27 @@ inherited frmEditCslt: TfrmEditCslt
'Component = cmdLexSearch'
'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'))
end
object mnuPopProvDx: TPopupMenu
Left = 353
Top = 77
Top = 129
object mnuPopProvDxDelete: TMenuItem
Caption = 'Delete diagnosis'
OnClick = mnuPopProvDxDeleteClick
@ -449,8 +547,8 @@ inherited frmEditCslt: TfrmEditCslt
end
object popReason: TPopupMenu
OnPopup = popReasonPopup
Left = 411
Top = 169
Left = 523
Top = 369
object popReasonCut: TMenuItem
Caption = 'Cu&t'
ShortCut = 16472

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

@ -5,10 +5,26 @@ interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
Menus, fBase508Form, VA508AccessibilityManager;
Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form;
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;
cboUrgency: TORComboBox;
radInpatient: TRadioButton;
@ -16,34 +32,25 @@ type
cboPlace: TORComboBox;
txtProvDiag: TCaptionEdit;
txtAttn: TORComboBox;
lblReason: TLabel;
lblService: TLabel;
lblUrgency: TStaticText;
lblPlace: TStaticText;
lblAttn: TStaticText;
lblProvDiag: TStaticText;
cboCategory: TORComboBox;
pnlMessage: TPanel;
imgMessage: TImage;
memMessage: TRichEdit;
cmdAccept: TButton;
cmdQuit: TButton;
memComment: TRichEdit;
lblComment: TLabel;
lblComments: TLabel;
btnCmtCancel: TButton;
btnCmtOther: TButton;
cmdLexSearch: TButton;
lblEarliest: TStaticText;
calEarliest: TORDateBox;
lblLatest: TStaticText;
calLatest: TORDateBox;
mnuPopProvDx: TPopupMenu;
mnuPopProvDxDelete: TMenuItem;
cmdLexSearch: TButton;
lblInpOutp: TStaticText;
memReason: TRichEdit;
popReason: TPopupMenu;
popReasonCut: TMenuItem;
popReasonCopy: TMenuItem;
popReasonPaste: TMenuItem;
popReasonPaste2: TMenuItem;
popReasonReformat: TMenuItem;
pnlCombatVet: TPanel;
txtCombatVet: TVA508StaticText;
procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer);
procedure radInpatientClick(Sender: TObject);
@ -68,13 +75,21 @@ type
procedure memCommentKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure memCommentKeyPress(Sender: TObject; var Key: Char);
procedure calEarliestExit(Sender: TObject);
procedure calLatestExit(Sender: TObject);
procedure memCommentExit(Sender: TObject);
private
FLastServiceID: string;
FChanged: boolean;
FChanging: boolean;
FEditCtrl: TCustomEdit;
FNavigatingTab: boolean;
FEarliestDate: TFMDateTime;
FProstheticsSvc: boolean;
//FLatestDate: TFMDateTime;
procedure SetProvDiagPromptingMode;
procedure SetUpCombatVet;
procedure SetUpEarliestDate;
protected
procedure InitDialog;
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 +
'Another code must be selected';
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;
begin
@ -195,6 +212,14 @@ begin
cboPlace.SelectByID(OldRec.Place);
with cboUrgency do for i := 0 to Items.Count-1 do
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;
ProvDx.Code := OldRec.ProvDxCode;
if OldRec.ProvDxCodeInactive then
@ -212,6 +237,15 @@ begin
else
txtAttn.ItemIndex := -1;
SetProvDiagPromptingMode;
if (patient.CombatVet.IsEligible = True) then
begin
SetUpCombatVet;
end
else
begin
txtCombatVet.Enabled := False;
pnlCombatVet.SendToBack;
end;
FChanging := False;
StatusText('');
end;
@ -246,6 +280,13 @@ begin
end;
if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
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;
procedure TfrmEditCslt.txtAttnNeedData(Sender: TObject;
@ -317,6 +358,22 @@ begin
UrgencyName := '';
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
if ItemID <> OldRec.Place then
begin
@ -407,6 +464,20 @@ begin
if not ValidSave then Action := caNone;
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);
{Begin BillingAware}
var
@ -479,6 +550,18 @@ begin
cmdLexSearchClick(Self);
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);
begin
@ -654,6 +737,25 @@ begin
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;
Shift: TShiftState);
begin
@ -670,4 +772,22 @@ begin
Key := #0; //Disable shift-tab processin
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.

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

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

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

@ -5,47 +5,54 @@ interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
Menus, fBase508Form, VA508AccessibilityManager;
Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form;
type
TfrmEditProc = class(TfrmBase508Form)
TfrmEditProc = class(TfrmAutoSz)
cmdAccept: 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;
radInpatient: TRadioButton;
radOutpatient: TRadioButton;
cboPlace: TORComboBox;
txtProvDiag: TCaptionEdit;
txtAttn: TORComboBox;
lblProc: TLabel;
cboProc: TORComboBox;
lblReason: TLabel;
lblUrgency: TStaticText;
lblPlace: TStaticText;
lblAttn: TStaticText;
lblProvDiag: TStaticText;
cboCategory: TORComboBox;
cboService: TORComboBox;
lblService: TOROffsetLabel;
memComment: TRichEdit;
lblComment: TLabel;
lblComments: TLabel;
pnlMessage: TPanel;
imgMessage: TImage;
memMessage: TRichEdit;
btnCmtCancel: TButton;
btnCmtOther: TButton;
cmdLexSearch: TButton;
lblEarliest: TStaticText;
lblLatest: TStaticText;
calEarliest: TORDateBox;
calLatest: TORDateBox;
mnuPopProvDx: TPopupMenu;
mnuPopProvDxDelete: TMenuItem;
cmdLexSearch: TButton;
lblInpOutp: TStaticText;
memReason: TRichEdit;
popReason: TPopupMenu;
popReasonCut: TMenuItem;
popReasonCopy: TMenuItem;
popReasonPaste: TMenuItem;
popReasonPaste2: TMenuItem;
popReasonReformat: TMenuItem;
pnlCombatVet: TPanel;
txtCombatVet: TVA508StaticText;
procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer);
procedure cboProcNeedData(Sender: TObject; const StartFrom: String;
@ -73,13 +80,19 @@ type
procedure memReasonKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure memReasonKeyPress(Sender: TObject; var Key: Char);
procedure calEarliestExit(Sender: TObject);
procedure calLatestExit(Sender: TObject);
procedure memCommentExit(Sender: TObject);
private
FLastProcID: string;
FChanged: boolean;
FChanging: boolean;
FEditCtrl: TCustomEdit;
FNavigatingTab: boolean;
FEarliestDate: TFMDateTime;
//FLatestDate: TFMDateTime;
procedure SetProvDiagPromptingMode;
procedure SetUpCombatVet;
protected
procedure InitDialog;
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 +
'Another code must be selected';
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;
begin
@ -164,6 +179,7 @@ procedure TfrmEditProc.InitDialog;
var
i: integer;
begin
if FChanging then exit;
FChanging := True;
Defaults := TStringList.Create;
FastAssign(ODForProcedures, Defaults);
@ -198,6 +214,10 @@ begin
cboPlace.SelectByID(OldRec.Place);
with cboUrgency do for i := 0 to Items.Count-1 do
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;
ProvDx.Code := OldRec.ProvDxCode;
if OldRec.ProvDxCodeInactive then
@ -210,6 +230,15 @@ begin
btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0);
memComment.Clear ;
SetProvDiagPromptingMode;
if (patient.CombatVet.IsEligible = True) then
begin
SetUpCombatVet;
end
else
begin
txtCombatVet.Enabled := False;
pnlCombatVet.SendToBack;
end;
FChanging := False;
StatusText('');
end;
@ -237,6 +266,9 @@ begin
end;
if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
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;
procedure TfrmEditProc.txtAttnNeedData(Sender: TObject;
@ -246,6 +278,20 @@ begin
txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
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;
const StartFrom: string; Direction, InsertAt: Integer);
begin
@ -322,6 +368,21 @@ begin
UrgencyName := '';
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
if ItemID <> OldRec.Place then
@ -432,6 +493,18 @@ begin
cmdLexSearchClick(Self);
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);
begin
inherited;
@ -453,7 +526,7 @@ begin
begin
InfoBox('There are no services defined for this procedure.',
'Information', MB_OK or MB_ICONINFORMATION);
cboProc.ItemIndex := -1;
//cboProc.ItemIndex := -1;
InitDialog;
Exit ;
end;
@ -651,6 +724,25 @@ begin
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;
Shift: TShiftState);
begin
@ -670,7 +762,7 @@ end;
procedure TfrmEditProc.memReasonKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//The navigating tab controls were inadvertantently adding tab characters
//The navigating tab controls were inadvertently adding tab characters
//This should fix it
FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
if FNavigatingTab then

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

@ -3,33 +3,89 @@ inherited frmODCslt: TfrmODCslt
Left = 430
Top = 203
Width = 606
Height = 376
Height = 455
HorzScrollBar.Range = 590
VertScrollBar.Range = 340
Caption = 'Order a Consult'
Constraints.MinHeight = 376
Constraints.MinWidth = 606
Constraints.MinHeight = 442
Constraints.MinWidth = 590
Font.Charset = ANSI_CHARSET
ExplicitWidth = 606
ExplicitHeight = 376
ExplicitHeight = 455
PixelsPerInch = 96
TextHeight = 13
object lblService: TLabel [0]
object pnlCombatVet: TPanel [0]
Left = 0
Top = 0
Width = 598
Height = 25
Align = alTop
BevelOuter = bvLowered
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
object txtCombatVet: TVA508StaticText
Name = 'txtCombatVet'
Left = 1
Top = 1
Width = 596
Height = 23
Align = alClient
Alignment = taCenter
BevelOuter = bvNone
Enabled = False
TabOrder = 0
ShowAccelChar = True
end
end
inherited memOrder: TCaptionMemo
Left = 3
Top = 384
Width = 417
Height = 41
Anchors = [akLeft, akBottom]
Lines.Strings = (
'The order text...'
'----------------------------------------------'
'--------------------------------'
'An order message may be displayed here.')
TabOrder = 2
ExplicitLeft = 3
ExplicitTop = 384
ExplicitWidth = 417
ExplicitHeight = 41
end
object pnlMain: TPanel [2]
Left = 0
Top = 0
Width = 598
Height = 380
Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone
TabOrder = 1
DesignSize = (
598
380)
object lblService: TLabel
Left = 1
Top = 2
Width = 134
Height = 13
Caption = 'Consult to Service/Specialty'
end
object lblProvDiag: TLabel [1]
Left = 309
Top = 81
object lblProvDiag: TLabel
Left = 312
Top = 138
Width = 100
Height = 13
Anchors = [akTop, akRight]
Caption = 'Provisional Diagnosis'
end
object lblUrgency: TLabel [2]
object lblUrgency: TLabel
Left = 309
Top = 2
Width = 40
@ -37,15 +93,15 @@ inherited frmODCslt: TfrmODCslt
Anchors = [akTop, akRight]
Caption = 'Urgency'
end
object lblPlace: TLabel [3]
Left = 454
Top = 43
object lblPlace: TLabel
Left = 457
Top = 100
Width = 100
Height = 13
Anchors = [akTop, akRight]
Caption = 'Place of Consultation'
end
object lblAttn: TLabel [4]
object lblAttn: TLabel
Left = 454
Top = 2
Width = 42
@ -53,28 +109,49 @@ inherited frmODCslt: TfrmODCslt
Anchors = [akTop, akRight]
Caption = 'Attention'
end
object pnlReason: TPanel [5]
object lblLatest: TStaticText
Left = 454
Top = 43
Width = 116
Height = 17
Anchors = [akTop, akRight]
Caption = 'Latest appropriate date:'
TabOrder = 17
Visible = False
end
object lblEarliest: TStaticText
Left = 309
Top = 43
Width = 121
Height = 17
Anchors = [akTop, akRight]
Caption = 'Earliest appropriate date:'
TabOrder = 14
end
object pnlReason: TPanel
Left = 3
Top = 128
Width = 585
Height = 161
Top = 176
Width = 587
Height = 179
Anchors = [akLeft, akTop, akRight]
BevelOuter = bvNone
TabOrder = 10
Constraints.MinHeight = 53
TabOrder = 13
object lblReason: TLabel
Left = 0
Top = 0
Width = 585
Width = 587
Height = 13
Align = alTop
Caption = 'Reason for Request'
Constraints.MinHeight = 13
ExplicitWidth = 95
end
object memReason: TRichEdit
Left = 0
Top = 13
Width = 585
Height = 148
Width = 587
Height = 166
Align = alClient
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
@ -82,6 +159,7 @@ inherited frmODCslt: TfrmODCslt
Font.Name = 'Courier New'
Font.Style = []
Constraints.MinHeight = 40
MaxLength = 2147483645
ParentFont = False
PopupMenu = popReason
ScrollBars = ssBoth
@ -94,35 +172,17 @@ inherited frmODCslt: TfrmODCslt
OnKeyUp = memReasonKeyUp
end
end
inherited memOrder: TCaptionMemo
Left = 3
Top = 305
Width = 417
Height = 41
TabStop = True
Anchors = [akLeft, akBottom]
Lines.Strings = (
'The order text...'
'----------------------------------------------'
'--------------------------------'
'An order message may be displayed here.')
TabOrder = 11
ExplicitLeft = 3
ExplicitTop = 305
ExplicitWidth = 417
ExplicitHeight = 41
end
object cboService: TORComboBox [7]
object cboService: TORComboBox
Left = 0
Top = 16
Width = 274
Height = 113
Height = 154
Anchors = [akLeft, akTop, akRight]
Style = orcsSimple
AutoSelect = True
Caption = 'Consult to Service/Specialty'
Color = clWindow
DropDownCount = 12
DropDownCount = 16
ItemHeight = 13
ItemTipColor = clWindow
ItemTipEnable = True
@ -134,7 +194,6 @@ inherited frmODCslt: TfrmODCslt
Sorted = False
SynonymChars = '<>'
TabOrder = 0
TabStop = True
OnChange = ControlChange
OnClick = cboServiceSelect
OnExit = cboServiceExit
@ -142,7 +201,7 @@ inherited frmODCslt: TfrmODCslt
OnKeyUp = cboServiceKeyUp
CharsNeedMatch = 1
end
object cboUrgency: TORComboBox [8]
object cboUrgency: TORComboBox
Left = 309
Top = 16
Width = 133
@ -150,6 +209,7 @@ inherited frmODCslt: TfrmODCslt
Anchors = [akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Urgency'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
@ -162,19 +222,20 @@ inherited frmODCslt: TfrmODCslt
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 3
TabOrder = 4
TabStop = True
OnChange = ControlChange
CharsNeedMatch = 1
end
object cboPlace: TORComboBox [9]
Left = 454
Top = 56
object cboPlace: TORComboBox
Left = 457
Top = 113
Width = 136
Height = 21
Anchors = [akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Place of Consultation'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
@ -187,24 +248,25 @@ inherited frmODCslt: TfrmODCslt
Pieces = '2'
Sorted = False
SynonymChars = '<>'
TabOrder = 6
TabOrder = 9
OnChange = ControlChange
CharsNeedMatch = 1
end
object txtProvDiag: TCaptionEdit [10]
Left = 309
Top = 94
Width = 231
object txtProvDiag: TCaptionEdit
Left = 312
Top = 151
Width = 223
Height = 21
Anchors = [akTop, akRight]
MaxLength = 180
ParentShowHint = False
PopupMenu = mnuPopProvDx
ShowHint = True
TabOrder = 8
TabOrder = 11
OnChange = txtProvDiagChange
Caption = 'Provisional Diagnosis'
end
object txtAttn: TORComboBox [11]
object txtAttn: TORComboBox
Left = 454
Top = 16
Width = 136
@ -212,6 +274,7 @@ inherited frmODCslt: TfrmODCslt
Anchors = [akTop, akRight]
Style = orcsDropDown
AutoSelect = True
Caption = 'Attention'
Color = clWindow
DropDownCount = 8
ItemHeight = 13
@ -224,12 +287,12 @@ inherited frmODCslt: TfrmODCslt
Pieces = '2,3'
Sorted = False
SynonymChars = '<>'
TabOrder = 4
TabOrder = 5
OnChange = ControlChange
OnNeedData = txtAttnNeedData
CharsNeedMatch = 1
end
object treService: TORTreeView [12]
object treService: TORTreeView
Left = 0
Top = 38
Width = 298
@ -244,7 +307,7 @@ inherited frmODCslt: TfrmODCslt
Indent = 19
ParentFont = False
ReadOnly = True
TabOrder = 2
TabOrder = 3
Visible = False
OnChange = treServiceChange
OnCollapsing = treServiceCollapsing
@ -253,9 +316,10 @@ inherited frmODCslt: TfrmODCslt
OnKeyDown = treServiceKeyDown
OnKeyUp = treServiceKeyUp
OnMouseDown = treServiceMouseDown
Caption = 'object lblService: TLabel'
NodePiece = 0
end
object cboCategory: TORComboBox [13]
object cboCategory: TORComboBox
Left = 225
Top = -5
Width = 5
@ -273,11 +337,11 @@ inherited frmODCslt: TfrmODCslt
MaxLength = 0
Sorted = False
SynonymChars = '<>'
TabOrder = 15
TabOrder = 18
Visible = False
CharsNeedMatch = 1
end
object pnlServiceTreeButton: TKeyClickPanel [14]
object pnlServiceTreeButton: TKeyClickPanel
Left = 274
Top = 14
Width = 26
@ -293,7 +357,7 @@ inherited frmODCslt: TfrmODCslt
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
TabOrder = 2
TabStop = True
OnClick = btnServiceTreeClick
OnEnter = pnlServiceTreeButtonEnter
@ -303,7 +367,6 @@ inherited frmODCslt: TfrmODCslt
Top = 2
Width = 22
Height = 22
Hint = 'View services/specialties hierarchically'
Glyph.Data = {
26050000424D26050000000000003604000028000000100000000F0000000100
080000000000F000000000000000000000000001000000010000000000000000
@ -348,36 +411,24 @@ inherited frmODCslt: TfrmODCslt
FFFFFFFFFFFFFFFFFFFF00FB00FF0404040404FFFFFFFFFFFFFF070007FFFFFF
FFFFFFFFFFFFFFFFFFFF}
Margin = 0
ParentShowHint = False
ShowHint = True
OnClick = btnServiceTreeClick
end
end
object cmdLexSearch: TButton [15]
Left = 543
Top = 94
Width = 49
Height = 21
Anchors = [akTop, akRight]
Caption = 'Lexicon'
TabOrder = 9
OnClick = cmdLexSearchClick
end
object gbInptOpt: TGroupBox [16]
object gbInptOpt: TGroupBox
Left = 309
Top = 35
Top = 92
Width = 140
Height = 45
Anchors = [akTop, akRight]
Caption = 'Patient will be seen as an:'
TabOrder = 5
TabOrder = 8
object radInpatient: TRadioButton
Left = 3
Top = 20
Width = 61
Height = 13
Caption = '&Inpatient'
TabOrder = 0
TabOrder = 1
OnClick = radInpatientClick
end
object radOutpatient: TRadioButton
@ -386,46 +437,93 @@ inherited frmODCslt: TfrmODCslt
Width = 70
Height = 13
Caption = '&Outpatient'
TabOrder = 1
TabOrder = 0
OnClick = radOutpatientClick
end
end
object btnDiagnosis: TButton [17]
Left = 543
Top = 95
object btnDiagnosis: TButton
Left = 541
Top = 151
Width = 49
Height = 20
Height = 21
Anchors = [akTop, akRight]
Caption = 'Diagnosis'
TabOrder = 7
TabOrder = 10
OnClick = btnDiagnosisClick
end
inherited cmdAccept: TButton
Left = 439
Top = 315
Anchors = [akLeft, akBottom]
object cmdLexSearch: TButton
Left = 541
Top = 151
Width = 49
Height = 21
Anchors = [akTop, akRight]
Caption = 'Lexicon'
TabOrder = 12
ExplicitLeft = 439
ExplicitTop = 315
OnClick = cmdLexSearchClick
end
object calEarliest: TORDateBox
Left = 309
Top = 57
Width = 133
Height = 21
Anchors = [akTop, akRight]
TabOrder = 6
OnChange = ControlChange
DateOnly = True
RequireTime = False
end
object calLatest: TORDateBox
Left = 454
Top = 57
Width = 136
Height = 21
Anchors = [akTop, akRight]
TabOrder = 7
Visible = False
OnChange = ControlChange
DateOnly = True
RequireTime = False
end
object servicelbl508: TVA508StaticText
Name = 'servicelbl508'
Left = 151
Top = 1
Width = 106
Height = 15
Alignment = taLeftJustify
Caption = 'service (for screen R.)'
Enabled = False
TabOrder = 1
Visible = False
ShowAccelChar = True
end
end
inherited cmdAccept: TButton
Left = 427
Top = 394
Anchors = [akLeft, akBottom]
TabOrder = 3
ExplicitLeft = 427
ExplicitTop = 394
end
inherited cmdQuit: TButton
Left = 531
Top = 315
Top = 394
Width = 61
Anchors = [akLeft, akBottom]
TabOrder = 13
TabOrder = 4
ExplicitLeft = 531
ExplicitTop = 315
ExplicitTop = 394
ExplicitWidth = 61
end
inherited pnlMessage: TPanel
Left = 13
Top = 295
Top = 374
Width = 377
Anchors = [akLeft, akRight, akBottom]
TabOrder = 14
TabOrder = 5
ExplicitLeft = 13
ExplicitTop = 295
ExplicitTop = 374
ExplicitWidth = 377
inherited memMessage: TRichEdit
Width = 292
@ -434,56 +532,6 @@ inherited frmODCslt: TfrmODCslt
end
inherited amgrMain: TVA508AccessibilityManager
Data = (
(
'Component = pnlReason'
'Status = stsDefault')
(
'Component = memReason'
'Label = lblReason'
'Status = stsOK')
(
'Component = cboService'
'Status = stsDefault')
(
'Component = cboUrgency'
'Label = lblUrgency'
'Status = stsOK')
(
'Component = cboPlace'
'Label = lblPlace'
'Status = stsOK')
(
'Component = txtProvDiag'
'Label = lblProvDiag'
'Status = stsOK')
(
'Component = txtAttn'
'Label = lblAttn'
'Status = stsOK')
(
'Component = treService'
'Status = stsDefault')
(
'Component = cboCategory'
'Status = stsDefault')
(
'Component = pnlServiceTreeButton'
'Status = stsDefault')
(
'Component = cmdLexSearch'
'Status = stsDefault')
(
'Component = gbInptOpt'
'Status = stsDefault')
(
'Component = radInpatient'
'Status = stsDefault')
(
'Component = radOutpatient'
'Status = stsDefault')
(
'Component = btnDiagnosis'
'Status = stsDefault')
(
'Component = memOrder'
'Status = stsDefault')
@ -501,11 +549,80 @@ inherited frmODCslt: TfrmODCslt
'Status = stsDefault')
(
'Component = frmODCslt'
'Status = stsDefault')
(
'Component = pnlMain'
'Status = stsDefault')
(
'Component = lblLatest'
'Status = stsDefault')
(
'Component = lblEarliest'
'Status = stsDefault')
(
'Component = pnlReason'
'Status = stsDefault')
(
'Component = memReason'
'Status = stsDefault')
(
'Component = cboService'
'Status = stsDefault')
(
'Component = cboUrgency'
'Status = stsDefault')
(
'Component = cboPlace'
'Status = stsDefault')
(
'Component = txtProvDiag'
'Status = stsDefault')
(
'Component = txtAttn'
'Status = stsDefault')
(
'Component = treService'
'Status = stsDefault')
(
'Component = cboCategory'
'Status = stsDefault')
(
'Component = pnlServiceTreeButton'
'Status = stsDefault')
(
'Component = gbInptOpt'
'Status = stsDefault')
(
'Component = radInpatient'
'Status = stsDefault')
(
'Component = radOutpatient'
'Status = stsDefault')
(
'Component = btnDiagnosis'
'Status = stsDefault')
(
'Component = cmdLexSearch'
'Status = stsDefault')
(
'Component = calEarliest'
'Status = stsDefault')
(
'Component = calLatest'
'Status = stsDefault')
(
'Component = pnlCombatVet'
'Status = stsDefault')
(
'Component = txtCombatVet'
'Status = stsDefault')
(
'Component = servicelbl508'
'Status = stsDefault'))
end
object mnuPopProvDx: TPopupMenu
Left = 353
Top = 77
Left = 489
Top = 150
object mnuPopProvDxDelete: TMenuItem
Caption = 'Delete diagnosis'
OnClick = mnuPopProvDxDeleteClick
@ -513,8 +630,8 @@ inherited frmODCslt: TfrmODCslt
end
object popReason: TPopupMenu
OnPopup = popReasonPopup
Left = 411
Top = 188
Left = 547
Top = 316
object popReasonCut: TMenuItem
Caption = 'Cu&t'
ShortCut = 16472

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

@ -8,40 +8,48 @@ uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet,
VA508AccessibilityManager ;
ORDtTm, VA508AccessibilityManager ;
type
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;
cboUrgency: TORComboBox;
cboPlace: TORComboBox;
txtProvDiag: TCaptionEdit;
txtAttn: TORComboBox;
lblService: TLabel;
lblUrgency: TLabel;
lblPlace: TLabel;
lblAttn: TLabel;
lblProvDiag: TLabel;
treService: TORTreeView;
cboCategory: TORComboBox;
pnlServiceTreeButton: TKeyClickPanel;
btnServiceTree: TSpeedButton;
gbInptOpt: TGroupBox;
radInpatient: TRadioButton;
radOutpatient: TRadioButton;
btnDiagnosis: TButton;
cmdLexSearch: TButton;
calEarliest: TORDateBox;
calLatest: TORDateBox;
mnuPopProvDx: TPopupMenu;
mnuPopProvDxDelete: TMenuItem;
cmdLexSearch: TButton;
popReason: TPopupMenu;
popReasonCut: TMenuItem;
popReasonCopy: TMenuItem;
popReasonPaste: TMenuItem;
popReasonPaste2: TMenuItem;
popReasonReformat: TMenuItem;
gbInptOpt: TGroupBox;
radInpatient: TRadioButton;
radOutpatient: TRadioButton;
pnlReason: TPanel;
lblReason: TLabel;
memReason: TRichEdit;
btnDiagnosis: TButton;
pnlCombatVet: TPanel;
txtCombatVet: TVA508StaticText;
servicelbl508: TVA508StaticText;
procedure FormCreate(Sender: TObject);
procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer);
@ -95,6 +103,7 @@ type
FLastServiceID: string;
FEditCtrl: TCustomEdit;
FNavigatingTab: boolean;
LLS_LINE_INDEX: integer;
procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode);
procedure ReadServerVariables;
procedure SetProvDiagPromptingMode;
@ -106,6 +115,11 @@ type
procedure SaveConsultDxForNurse(pDiagnosis: string); // save the dx entered by nurese if Master BA switch is ON
procedure SetUpCopyConsultDiagnoses(pOrderID:string);
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
procedure InitDialog; override;
procedure Validate(var AnErrMsg: string); override;
@ -122,13 +136,16 @@ var
consultQuickOrder: boolean;
function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
implementation
{$R *.DFM}
uses
rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq,
ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility;
ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility,
VA508AccessibilityRouter;
var
SvcList, QuickList, Defaults: TStrings ;
@ -136,7 +153,7 @@ var
GMRCREAF: string;
BADxUpdated: boolean;
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_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_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_VIEW_SVC_HRCHY = 'View services/specialties hierarchically';
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);
begin
frmFrame.pnlVisit.Enabled := false;
@ -175,9 +226,7 @@ begin
btnDiagnosis.Visible := False;
cmdLexSearch.Visible := True;
end;
Defaults := TStringList.Create ;
SvcList := TStringList.Create ;
QuickList := TStringList.Create ;
InitializeGlobalLists;
AllowQuickOrder := True;
LastNode := 0;
FLastServiceID := '' ;
@ -189,15 +238,26 @@ begin
StatusText('Loading Default Values');
FastAssign(ODForConsults, Defaults); // ODForConsults returns TStrings with defaults
CtrlInits.LoadDefaults(Defaults);
calEarliest.Text := 'TODAY';
//calLatest.Text := 'TODAY+30';
txtAttn.InitLongList('') ;
PreserveControl(txtAttn);
PreserveControl(calEarliest);
//PreserveControl(calLatest);
if (patient.CombatVet.IsEligible = True) then
begin
SetUpCombatVet;
end
else
begin
txtCombatVet.Enabled := False;
pnlCombatVet.SendToBack;
end;
InitDialog;
//Calling virtual SetFontSize in constructor is a bad idea!
DoSetFontSize( MainFontSize);
FcboServiceKeyDownStopClick := false;
consultQuickOrder := false;
end;
procedure TfrmODCslt.InitDialog;
@ -232,12 +292,14 @@ begin
memOrder.Clear ;
memReason.Clear;
cboService.Enabled := True;
setup508Label(servicelbl508, cboService);
cboService.Font.Color := clWindowText;
cboService.Height := 25 + (7 * cboService.ItemHeight);
cboService.Height := 25 + (11 * cboService.ItemHeight);
btnServiceTree.Enabled := True;
pnlServiceTreeButton.Enabled := True;
SetProvDiagPromptingMode;
ActiveControl := cboService; // set after call to SetProvDiagPromptingMode
ActiveControl := cboService;
Changing := False;
StatusText('');
end;
@ -257,6 +319,7 @@ var
SvcIEN: string;
begin
inherited;
LLS_LINE_INDEX := -1;
ReadServerVariables;
AList := TStringList.Create;
try
@ -280,6 +343,7 @@ begin
Close;
Exit;
end;
cboService.Items.Add(SvcIEN + U + tmpResp.EValue + '^^^^' + tmpResp.IValue);
cboService.SelectByID(SvcIEN);
tmpResp := TResponse(FindResponseByName('CLASS',1));
@ -288,10 +352,14 @@ begin
radInpatient.Checked := True
else
radOutpatient.Checked := True ;
SetUpEarliestDate; //wat v28
SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
cboService.Enabled := False;
setup508Label(servicelbl508, cboService);
cboService.Font.Color := clGrayText;
btnServiceTree.Enabled := False;
pnlServiceTreeButton.Enabled := False;
@ -307,6 +375,7 @@ begin
if WasTemplateDialogCanceled then
begin
AbortOrder := True;
SetTemplateDialogCanceled(FALSE);
Close;
Exit;
end;
@ -315,6 +384,7 @@ begin
if WasTemplateDialogCanceled then
begin
AbortOrder := True;
SetTemplateDialogCanceled(FALSE);
Close;
Exit;
end;
@ -342,11 +412,13 @@ begin
begin
FastAssign(QuickList, cboService.Items);
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);
end;
Changing := True;
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
(Piece(AList.Strings[i], U, 5) <> '1') then
cboService.Items.Add(AList.Strings[i]);
@ -409,6 +481,9 @@ begin
else
SetError(TX_SELECT_DIAG);
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;
procedure TfrmODCslt.txtAttnNeedData(Sender: TObject;
@ -547,6 +622,7 @@ begin
cboService.ItemIndex := -1;
FLastServiceID := ItemID;
cboService.Enabled := False;
setup508Label(servicelbl508, cboService);
cboService.Font.Color := clGrayText;
btnServiceTree.Enabled := False;
pnlServiceTreeButton.Enabled := False;
@ -587,11 +663,14 @@ begin
SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
SetTemplateDialogCanceled(FALSE);
SetControl(memReason, 'COMMENT', 1);
if WasTemplateDialogCanceled and OrderContainsObjects then
begin
AbortOrder := TRUE;
SetTemplateDialogCanceled(FALSE);
Close;
Exit;
end;
@ -615,6 +694,7 @@ begin
end;
end;
SetProvDiagPromptingMode;
SetUpEarliestDate; //wat v28
tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6);
pnlMessage.TabOrder := treService.TabOrder + 1;
OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0)));
@ -645,11 +725,13 @@ begin
end
else Responses.Update('ORDERABLE', 1, '', '');
end;
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 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 txtAttn do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text);
with memReason do Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
with cboCategory do Responses.Update('CLASS', 1, ItemID, Text);
with cboUrgency do Responses.Update('URGENCY', 1, ItemID, Text);
with cboPlace do Responses.Update('PLACE', 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);
if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text)
else Responses.Update('MISC', 1, '', '');
@ -757,6 +839,7 @@ begin
memReason.Clear;
with cboService do
begin
setup508Label(servicelbl508, cboService);
if (ItemIndex < 0) or (ItemID = '') then
begin
Responses.Update('ORDERABLE', 1, '', '');
@ -781,6 +864,8 @@ begin
consultQuickOrder := True;
tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).EValue;
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;
for i := 0 to Items.Count-1 do
begin
@ -792,6 +877,7 @@ begin
end;*)
FLastServiceID := ItemID;
Enabled := False;
setup508Label(servicelbl508, cboService);
Font.Color := clGrayText;
btnServiceTree.Enabled := False;
pnlServiceTreeButton.Enabled := False;
@ -810,11 +896,14 @@ begin
SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
SetTemplateDialogCanceled(FALSE);
SetControl(memReason, 'COMMENT', 1);
if WasTemplateDialogCanceled and OrderContainsObjects then
begin
AbortOrder := TRUE;
SetTemplateDialogCanceled(FALSE);
Close;
Exit;
end;
@ -860,13 +949,14 @@ begin
OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0)));
//OrderMessage(ConsultMessage(cboService.ItemIEN));
ControlChange(Self) ;
SetUpEarliestDate; //wat v28
setup508Label(servicelbl508, cboService);
end;
procedure TfrmODCslt.FormDestroy(Sender: TObject);
begin
Defaults.Free;
SvcList.Free ;
QuickList.Free;
if not FreeGlobalLists then
Exit;
inherited;
end;
@ -985,7 +1075,6 @@ begin
if ProvDx.Text[i-1] = '*' then i := i - 2;
ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
ProvDx.CodeInactive := False;
end;
@ -1056,6 +1145,17 @@ begin
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);
begin
inherited;
@ -1492,6 +1592,73 @@ const
begin
pnlReason.Top := cboService.Top + cboService.Height + 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.

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

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

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

@ -5,38 +5,46 @@ interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
Menus, VA508AccessibilityManager;
Menus, ORDtTm, VA508AccessibilityManager;
type
TfrmODProc = class(TfrmODBase)
cboUrgency: TORComboBox;
cboPlace: TORComboBox;
txtAttn: TORComboBox;
pnlMain: TPanel;
pnlCombatVet: TPanel;
lblProc: TLabel;
cboProc: TORComboBox;
lblService: TOROffsetLabel;
lblReason: TLabel;
lblUrgency: TStaticText;
lblPlace: TStaticText;
lblAttn: TStaticText;
lblProvDiag: TStaticText;
pnlReason: TPanel;
memReason: TCaptionRichEdit;
cboUrgency: TORComboBox;
cboPlace: TORComboBox;
txtAttn: TORComboBox;
cboProc: TORComboBox;
cboCategory: 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;
mnuPopProvDxDelete: TMenuItem;
cmdLexSearch: TButton;
popReason: TPopupMenu;
popReasonCut: TMenuItem;
popReasonCopy: TMenuItem;
popReasonPaste: TMenuItem;
popReasonPaste2: TMenuItem;
popReasonReformat: TMenuItem;
pnlReason: TPanel;
memReason: TCaptionRichEdit;
gbInptOpt: TGroupBox;
radInpatient: TRadioButton;
radOutpatient: TRadioButton;
txtProvDiag: TCaptionEdit;
lblReason: TLabel;
txtCombatVet: TVA508StaticText;
servicelbl508: TVA508StaticText;
procedure FormCreate(Sender: TObject);
procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer);
@ -63,6 +71,7 @@ type
procedure memReasonKeyPress(Sender: TObject; var Key: Char);
procedure FormResize(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
private
FLastProcID: string;
FEditCtrl: TCustomEdit;
@ -73,6 +82,9 @@ type
procedure GetProvDxandValidateCode(AResponses: TResponses);
function ShowPrerequisites: boolean;
procedure DoSetFontSize( FontSize: integer);
procedure SetUpCombatVet;
procedure updateService;
procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
protected
procedure InitDialog; override;
procedure Validate(var AnErrMsg: string); override;
@ -82,18 +94,23 @@ type
procedure SetFontSize( FontSize: integer); override;
end;
function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
implementation
{$R *.DFM}
uses
rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses,
clipbrd, fPreReq, uTemplates, fFrame, uODBase,
clipbrd, fPreReq, uTemplates, fFrame, uODBase, VA508AccessibilityRouter,
uVA508CPRSCompatibility;
var
ProvDx: TProvisionalDiagnosis;
GMRCREAF: string;
OkToFreeProcDialog: boolean;
const
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_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_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);
begin
frmFrame.pnlVisit.Enabled := false;
AutoSizeDisabled := True;
inherited;
OkToFreeProcDialog := False;
DoSetFontSize(MainFontSize);
AllowQuickOrder := True;
FillChar(ProvDx, SizeOf(ProvDx), 0);
@ -125,8 +156,21 @@ begin
ReadServerVariables;
cboProc.InitLongList('') ;
txtAttn.InitLongList('') ;
calEarliest.Text := 'TODAY';
//calLatest.Text := 'TODAY+30';
PreserveControl(calEarliest);
//PreserveControl(calLatest);
PreserveControl(txtAttn);
PreserveControl(cboProc);
if (patient.CombatVet.IsEligible = True) then
begin
SetUpCombatVet;
end
else
begin
txtCombatVet.Enabled := False;
pnlCombatVet.SendToBack;
end;
InitDialog;
end;
@ -197,6 +241,8 @@ begin
SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
cboProc.Enabled := False;
cboProc.Font.Color := clGrayText;
//SetControl(cboService, 'SERVICE', 1); // to fix OR*3.0*95 bug in v17.6 (RV)
@ -229,6 +275,8 @@ begin
if WasTemplateDialogCanceled then
begin
AbortOrder := True;
OkToFreeProcDialog := true;
SetTemplateDialogCanceled(FALSE);
Close;
Exit;
end;
@ -237,6 +285,8 @@ begin
if WasTemplateDialogCanceled then
begin
AbortOrder := True;
OkToFreeProcDialog := true;
SetTemplateDialogCanceled(FALSE);
Close;
Exit;
end;
@ -269,6 +319,9 @@ begin
else
SetError(TX_SELECT_DIAG);
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;
procedure TfrmODProc.txtAttnNeedData(Sender: TObject;
@ -336,15 +389,14 @@ begin
end
else Responses.Update('ORDERABLE', 1, '', '');
end;
(* with cboProc do if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
else Responses.Update('ORDERABLE', 1, '', '');*)
with cboService do if ItemIEN > 0 then Responses.Update('SERVICE', 1, ItemID, Text)
else Responses.Update('SERVICE', 1, '', '');
updateService();
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 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 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)
else Responses.Update('MISC', 1, '', '');
if Length(ProvDx.Code) > 0 then Responses.Update('CODE', 1, ProvDx.Code, ProvDx.Code)
@ -414,6 +466,8 @@ begin
SetControl(cboUrgency, 'URGENCY', 1);
SetControl(cboPlace, 'PLACE', 1);
SetControl(txtAttn, 'PROVIDER', 1);
SetControl(calEarliest, 'EARLIEST', 1);
//SetControl(calLatest, 'LATEST', 1);
SetTemplateDialogCanceled(FALSE);
SetControl(memReason, 'COMMENT', 1);
if WasTemplateDialogCanceled and OrderContainsObjects then
@ -587,6 +641,17 @@ begin
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);
begin
inherited;
@ -812,6 +877,20 @@ begin
DoSetFontSize(FontSize);
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);
begin
memReason.Width := pnlReason.ClientWidth;
@ -839,16 +918,40 @@ end;
procedure TfrmODProc.FormResize(Sender: TObject);
begin
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;
procedure TfrmODProc.FormShow(Sender: TObject);
begin
inherited;
setup508Label('No service selected.', servicelbl508, cboService);
end;
procedure TfrmODProc.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
frmFrame.pnlVisit.Enabled := true;
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.

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

@ -136,7 +136,6 @@ begin
repeat
with Lines do
begin
AddStrings(AHeader);
for i := 0 to MaxLines do
if i < memReport.Lines.Count then
Add(memReport.Lines[LastLine + i])
@ -156,7 +155,7 @@ begin
end;
end;
until LastLine >= memReport.Lines.Count - 1;
PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg);
PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg, True);
end;
finally
memPrintReport.Free;
@ -184,8 +183,9 @@ end;
procedure TfrmPrerequisites.FormCreate(Sender: TObject);
begin
inherited;
ResizeAnchoredFormToFont(Self);
SetFormPosition(Self); //Get Saved Position & Size of Form
ResizeAnchoredFormToFont(Self);
//SetFormPosition(Self); //Get Saved Position & Size of Form
end;
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 GetServicePrerequisites(Service: string): TStrings;
procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
function IsProstheticsService(SvcIen: int64) : string;
{ Clinical Procedures Specific}
function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
@ -353,6 +354,8 @@ begin
InOut := Piece(x, U, 18) ;
Findings := Piece(x, U, 19) ;
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!!!!
alist.delete(0) ;
TIUDocuments := TStringList.Create ;
@ -667,6 +670,8 @@ begin
ConsultProcName := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 2);
Urgency := StrToIntDef(Piece(ExtractDefault(Dest, 'URGENCY'), U, 3), 0);
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);
PlaceName := Piece(ExtractDefault(Dest, 'PLACE'), U, 2);
Attention := StrToInt64Def(Piece(ExtractDefault(Dest, 'ATTENTION'), U, 1), 0);
@ -733,6 +738,10 @@ begin
for i := 0 to NewComments.Count - 1 do
Mult['10,' + IntToStr(i+1)] := NewComments.Strings[i];
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;
CallBroker;
Result := '0';
@ -835,6 +844,11 @@ begin
Result := AnEditRec;
end;
function IsProstheticsService(SvcIen : int64) : string; //wat v28
begin
Result := sCallV('ORQQCN ISPROSVC', [SvcIen]);
end;
initialization
uLastOrderedIEN := 0;
uLastOrderMsg := '';

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

@ -3,7 +3,8 @@ unit uConsults;
interface
uses
SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls;
SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls,
Contnrs, DateUtils;
type
@ -37,8 +38,8 @@ type
ProvDiagnosis: string ; { 30} { * }
ProvDxCode: string; { 30.1}
RequestProcessingActivity: TStringList; { 40}
//EarliestDate: TFMDateTime;
//LatestDate: TFMDateTime;
EarliestDate: TFMDateTime;
//LatestDate: TFMDateTime; //dropped requirement WAT
end ;
TEditResubmitRec = record
@ -52,8 +53,8 @@ type
ConsultProcName: string;
Urgency: integer;
UrgencyName: string;
//EarliestDate: TFMDateTime;
//LatestDate: TFMDateTime;
EarliestDate: TFMDateTime;
//LatestDate: TFMDateTime; //dropped requirement WAT
Place: string;
PlaceName: string;
Attention: int64;
@ -258,36 +259,109 @@ end;
procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode);
var
MyID, MyParent, Name, temp: string;
i: Integer;
ChildNode, tmpNode: TORTreeNode;
MyID, MyParent, Name, item: string;
i, Idx: Integer;
ParentNode, ChildNode: TORTreeNode;
// tmpNode: TORTreeNode;
HasChildren: Boolean;
begin
Tree.Items.BeginUpdate;
with SvcList do for i := 0 to Count - 1 do
// 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
if Piece(Strings[i], U, 5) = 'S' then Continue; // V19.4 {rv}
//if Piece(Strings[i], U, 6) = 'S' then Continue;
MyParent := Piece(Strings[i], U, 3);
if (MyParent = Parent) then
bad := false;
if AllNodes.Find(MyID, Idx) then
begin
MyID := Piece(Strings[i], U, 1);
Name := Piece(Strings[i], U, 2);
temp := Strings[i];
tmpNode := nil;
HasChildren := Piece(Strings[i], U, 4) = '+';
if Node <> nil then if Node.HasChildren then
tmpNode := Tree.FindPieceNode(MyID, 1, U, Node);
if (tmpNode <> nil) and tmpNode.HasAsParent(Node) then
Continue
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
ChildNode := TORTreeNode(Tree.Items.AddChild(Node, Name));
ChildNode.StringData := temp;
if HasChildren then BuildServiceTree(Tree, SvcList, MyID, ChildNode);
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
Tree.Items.BeginUpdate;
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
item := SvcList[i];
if Piece(item, U, 5) = 'S' then Continue;
MyParent := Piece(item, U, 3);
MyID := Piece(item, U, 1);
if not ParentNodes.Find(MyParent, Idx) then
ParentNode := nil
else
begin
ParentNode := TORTreeNode(ParentNodes.Objects[Idx]);
// FilterOutDuplicates;
// if bad then Continue;
end;
Name := Piece(item, U, 2);
HasChildren := Piece(item, U, 4) = '+';
ChildNode := TORTreeNode(Tree.Items.AddChild(ParentNode, Name));
ChildNode.StringData := item;
// AddNode;
if HasChildren then
ParentNodes.AddObject(MyID, ChildNode);
end;
finally
ParentNodes.Free;
// AllNodes.Free;
// Lists.Free;
end;
Tree.Items.EndUpdate;
end;

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

@ -24,7 +24,8 @@ type
Rect: TRect; State: TOwnerDrawState);
private
procedure EnsurePrimaryDiag;
function isProblem(diagnosis: TPCEDiag): Boolean;
function isEncounterDx(problem: string): Boolean;
protected
procedure UpdateNewItemStr(var x: string); 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 +
'via the Problems tab.';
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
frmDiagnoses: TfrmDiagnoses;
@ -64,8 +68,8 @@ begin
if not Primary and (Items.Count > 0) then
begin
GridIndex := 0;
TPCEDiag(Items.Objects[0]).Primary := True;
GridIndex := Items.Count - 1;//0; vhaispbellc CQ 15836
TPCEDiag(Items.Objects[Items.Count - 1]).Primary := True;
GridChanged;
end;
end;
@ -100,6 +104,7 @@ begin
for i := 0 to lbGrid.Items.Count-1 do
if(lbGrid.Selected[i]) then
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);
GridChanged;
end;
@ -131,6 +136,81 @@ begin
x := x + U + '0';
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;
var
i, j, k, PLItemCount: integer;
@ -148,8 +228,13 @@ begin
PLItemCount := 0;
if OK then
for k := 0 to lbGrid.Items.Count - 1 do
if (lbGrid.Selected[k]) and (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) then
begin
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);
ckbDiagProb.Enabled := OK;
if(OK) then
@ -179,8 +264,7 @@ end;
procedure TfrmDiagnoses.FormResize(Sender: TObject);
begin
inherited;
if lbxSection.width = 0 then Exit;
FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth);
FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (10 * MainFontWidth) - ScrollBarWidth);
FSectionTabs[1] := -FSectionTabs[0]+2;
FSectionTabs[2] := -FSectionTabs[0]+4;
UpdateTabPos;
@ -189,12 +273,21 @@ end;
procedure TfrmDiagnoses.lbxSectionClickCheck(Sender: TObject;
Index: Integer);
begin
if not FUpdatingGrid then
if (lbxSection.Checked[Index]) and (Piece(lbxSection.Items[Index], U, 5) = '#') then
if (not FUpdatingGrid) and (lbxSection.Checked[Index]) then
begin
if (Piece(lbxSection.Items[Index], U, 5) = '#') then
begin
InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
lbxSection.Checked[Index] := False;
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;
EnsurePrimaryDiag;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -49,6 +49,13 @@ var
begin
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
begin
if Assigned(NoteData) then
@ -129,12 +136,14 @@ end;
procedure TfrmPCEEdit.FormCreate(Sender: TObject);
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
begin
KillObj(@uPCETemp);
KillObj(@uPCETempOld);
end;
uPatient := Patient.DFN;
uPatient := Patient.DFN; *)
end;
initialization

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

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

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

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

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

@ -6,9 +6,8 @@ inherited frmVisitType: TfrmVisitType
Constraints.MinHeight = 465
Constraints.MinWidth = 600
OnCloseQuery = FormCloseQuery
ExplicitLeft = 260
ExplicitWidth = 600
ExplicitHeight = 472
ExplicitHeight = 465
PixelsPerInch = 96
TextHeight = 13
inherited btnOK: TBitBtn
@ -192,7 +191,7 @@ inherited frmVisitType: TfrmVisitType
Height = 164
Align = alRight
TabOrder = 1
ExplicitLeft = 384
ExplicitLeft = 422
ExplicitWidth = 208
ExplicitHeight = 164
inherited gbVisitRelatedTo: TGroupBox
@ -255,6 +254,7 @@ inherited frmVisitType: TfrmVisitType
TabOrder = 0
OnEnter = memSCDisplayEnter
Caption = 'Service Connection && Rated Disabilities'
ExplicitWidth = 422
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
Left = 315
Top = 110
Width = 435
Height = 397
HelpContext = 9999
VertScrollBar.Range = 360
@ -10,11 +9,8 @@ inherited frmOptions: TfrmOptions
Caption = 'Options'
Font.Name = 'Tahoma'
HelpFile = 'CPRSWT.HLP'
OldCreateOrder = True
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
ExplicitWidth = 435
ExplicitHeight = 397
PixelsPerInch = 96
TextHeight = 13
@ -1358,10 +1354,10 @@ inherited frmOptions: TfrmOptions
TabOrder = 6
end
object memReport2: TMemo
Left = 128
Top = 213
Left = 135
Top = 212
Width = 273
Height = 47
Height = 48
TabStop = False
BorderStyle = bsNone
Color = clBtnFace

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

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

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

@ -184,7 +184,10 @@ begin
valuesource := radAddByType.Items[radAddByType.ItemIndex];
if copy(valuesource, 1, 1) = '&' then
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);
if Duplicate(valueien, valuesource) then exit; // check for duplicates
aListItem := lvwCombinations.Items.Add;

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

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

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

@ -57,6 +57,7 @@ type
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure lstAddByKeyPress(Sender: TObject; var Key: Char);
procedure grpVisibilityClick(Sender: TObject);
procedure lstAddByChange(Sender: TObject);
private
{ Private declarations }
FLastList: integer;
@ -145,7 +146,7 @@ begin
begin
case radAddByType.ItemIndex of
0: begin
ListItemsOnly := true;
ListItemsOnly := false;
LongList := true;
InitLongList('');
lblAddby.Caption := 'Patient:';
@ -255,6 +256,37 @@ begin
btnListSaveChanges.Enabled := false;
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);
var
ien: string;
@ -265,6 +297,7 @@ var
begin
if lstAddBy.ItemIndex < 0 then exit;
ien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
If ien = '' then exit;
case radAddByType.ItemIndex of
0:
begin

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

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

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

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

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

@ -47,11 +47,14 @@ type
procedure txtEncStartExit(Sender: TObject);
procedure txtEncStopExit(Sender: TObject);
procedure btnEncDefaultsClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure btnCancelClick(Sender: TObject);
private
{ Private declarations }
FstartDt: TFMDateTime;
FstopDt: TFMDateTime;
FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer;
OK2Closed: boolean;
//FDefaultEvent: string;
public
{ Public declarations }
@ -106,6 +109,7 @@ var
last: integer;
values, tab: string;
begin
OK2Closed := True;
FastAssign(rpcGetOtherTabs, cboTab.Items);
if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then
cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery'));
@ -141,6 +145,7 @@ procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
var
values, theVal: string;
begin
OK2Closed := True;
values := '';
if cboTab.ItemIEN <> cboTab.Tag then
values := values + cboTab.ItemID;
@ -153,6 +158,40 @@ begin
values := values + '0';
values := 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
begin
if dtStop.FMDateTime < dtStart.FMDateTime then
@ -160,6 +199,7 @@ begin
ShowMsg('The stop time can not prior to the start time.');
dtStop.FMDateTime := FMToday;
dtStop.SetFocus;
OK2Closed := false;
Exit;
end;
theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime;
@ -172,6 +212,14 @@ begin
frmMeds.RefreshMedLists;
end;
procedure TfrmOptionsOther.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
inherited;
CanClose := OK2Closed;
end;
procedure TfrmOptionsOther.FormCreate(Sender: TObject);
begin
FStartDT := 0;
@ -203,13 +251,13 @@ end;
procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
begin
if (dtStart.FMDateTime > FMToday) then
(* if (dtStart.FMDateTime > FMToday) then
begin
ShowMsg('Start time can not greater than today.');
dtStart.FMDateTime := FMToday;
dtStart.SetFocus;
Exit;
end;
end; *)
end;
procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
@ -264,6 +312,12 @@ with txtEncStart do
Text := '0';
end;
procedure TfrmOptionsOther.btnCancelClick(Sender: TObject);
begin
inherited;
OK2Closed := True;
end;
procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
begin
txtEncStart.Text := IntToStr(FEncDefStartDays);

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

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

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

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

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

@ -1,112 +1,206 @@
inherited frmOCSession: TfrmOCSession
Left = 366
Top = 222
Width = 714
Height = 530
HorzScrollBar.Visible = True
VertScrollBar.Visible = True
AutoScroll = True
BorderIcons = []
Caption = 'Order Checks'
ClientWidth = 494
Constraints.MinHeight = 500
Constraints.MinWidth = 500
Position = poScreenCenter
ShowHint = True
OnClose = FormClose
OnCreate = FormCreate
OnMouseWheelDown = FormMouseWheelDown
OnShow = FormShow
ExplicitWidth = 502
ExplicitHeight = 240
ExplicitWidth = 714
ExplicitHeight = 530
PixelsPerInch = 96
TextHeight = 13
object lstChecks: TCaptionListBox [0]
object pnlBottom: TPanel [0]
Left = 0
Top = 0
Width = 494
Height = 162
Style = lbOwnerDrawVariable
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
Top = 352
Width = 706
Height = 146
Anchors = [akLeft, akTop, akBottom]
BevelOuter = bvNone
TabOrder = 0
DesignSize = (
494
111)
706
146)
object lblJustify: TLabel
Left = 9
Top = 34
Width = 248
Top = 58
Width = 234
Height = 13
Anchors = [akLeft, akTop, akRight]
Caption = 'Enter justification for overriding critical order checks -'
Anchors = [akLeft]
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
object txtJustify: TCaptionEdit
Left = 8
Top = 50
Width = 478
Top = 80
Width = 682
Height = 21
Anchors = [akLeft, akTop, akRight]
Anchors = [akLeft]
AutoSize = False
MaxLength = 80
TabOrder = 0
TabOrder = 3
OnKeyDown = txtJustifyKeyDown
Caption = 'Enter justification for overriding critical order checks -'
end
object cmdCancelOrder: TButton
Left = 356
Top = 5
Width = 131
Left = 9
Top = 17
Width = 168
Height = 21
Anchors = [akLeft, akTop, akRight]
Caption = 'Cancel Selected Order(s)'
TabOrder = 3
Caption = 'Cancel Checked Order(s)'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = cmdCancelOrderClick
end
object cmdContinue: TButton
Left = 157
Top = 82
Width = 70
Height = 21
Caption = 'Continue'
Left = 219
Top = 112
Width = 127
Height = 23
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
OnClick = cmdContinueClick
end
object btnReturn: TButton
Left = 241
Top = 82
Width = 97
Height = 21
Left = 352
Top = 112
Width = 122
Height = 23
Anchors = [akLeft, akTop, akRight, akBottom]
Cancel = True
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
OnClick = btnReturnClick
end
object memNote: TMemo
Left = 8
Top = 4
Width = 329
Height = 29
BorderStyle = bsNone
Color = clBtnFace
Lines.Strings = (
'NOTE: The override justification is for tracking purposes and '
'does not change or place new order(s).')
ReadOnly = True
object cmdMonograph: TButton
Left = 536
Top = 107
Width = 162
Height = 21
Anchors = [akRight, akBottom]
Caption = 'Drug Interaction Monograph'
TabOrder = 6
OnClick = cmdMonographClick
end
end
object pnlTop: TORAutoPanel [1]
Left = 0
Top = 0
Width = 706
Height = 346
Align = alTop
BevelEdges = []
BevelOuter = bvNone
TabOrder = 1
OnEnter = memNoteEnter
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
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
inherited amgrMain: TVA508AccessibilityManager
Data = (
(
'Component = lstChecks'
'Status = stsDefault')
(
'Component = pnlBottom'
'Status = stsDefault')
@ -127,6 +221,15 @@ inherited frmOCSession: TfrmOCSession
'Status = stsDefault')
(
'Component = frmOCSession'
'Status = stsDefault')
(
'Component = cmdMonograph'
'Status = stsDefault')
(
'Component = grdchecks'
'Status = stsDefault')
(
'Component = pnlTop'
'Status = stsDefault'))
end
end

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

@ -3,12 +3,12 @@ unit fOCSession;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager;
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fOCMonograph,
fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager,
Grids, strUtils, uDlgComponents, VAUtils, VA508AccessibilityRouter;
type
TfrmOCSession = class(TfrmAutoSz)
lstChecks: TCaptionListBox;
pnlBottom: TPanel;
lblJustify: TLabel;
txtJustify: TCaptionEdit;
@ -16,12 +16,13 @@ type
cmdContinue: TButton;
btnReturn: TButton;
memNote: TMemo;
cmdMonograph: TButton;
grdchecks: TCaptionStringGrid;
lblInstr: TVA508StaticText;
pnlTop: TORAutoPanel;
lblHover: TLabel;
procedure cmdCancelOrderClick(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 FormShow(Sender: TObject);
procedure FormResize(Sender: TObject);
@ -29,6 +30,32 @@ type
Shift: TShiftState);
procedure btnReturnClick(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
FCritical: Boolean;
FCancelSignProcess : Boolean;
@ -111,13 +138,12 @@ end;
Clears OrderList If False. }
function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean;
var
i, j: Integer;
LastID, NewID: string;
CheckList: TStringList;
i, j, k, l, m, rowcnt: Integer;
LastID, NewID, gridtext: string;
CheckList,remOC: TStringList;
OCRec: TOCRec;
//AChangeItem: TChangeItem;
frmOCSession: TfrmOCSession;
x: string;
x,substring: string;
begin
Result := True;
CheckList := TStringList.Create;
@ -128,6 +154,14 @@ begin
if CheckList.Count > 0 then
begin
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
ResizeFormToFont(TForm(frmOCSession));
uCheckedOrders := TList.Create;
@ -147,15 +181,69 @@ begin
OCRec := TOCRec(Items[i]);
x := TextForOrder(OCRec.OrderID);
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
if Piece(CheckList[j], U, 1) = OCRec.OrderID then
begin
OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4));
x := x + CRLF + Piece(CheckList[j], U, 4);
l := l+1;
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;
//AChangeItem := Changes.Locate(CH_ORD, OCRec.OrderID);
//if AChangeItem <> nil then OCRec.OrderText := AChangeItem.Text;
frmOCSession.lstChecks.Items.Add(x);
end; {with...for i}
frmOCSession.FOrderList := OrderList;
frmOCSession.FCheckList := CheckList;
@ -169,6 +257,17 @@ begin
if Assigned(frmFrame) then
frmFrame.SetActiveTab(CT_ORDERS);
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
with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free;
frmOCSession.Free;
@ -179,6 +278,19 @@ begin
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;
var
i, j: Integer;
@ -194,135 +306,604 @@ begin
lblJustify.Visible := FCritical;
txtJustify.Visible := FCritical;
memNote.Visible := FCritical;
end;
procedure TfrmOCSession.lstChecksMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
var
i, AHt, TotalHt: Integer;
x: string;
ARect: TRect;
OCRec: TOCRec;
function TfrmOCSession.CheckBoxRect(poRect: TRect): TRect;
const ciCheckBoxDim = 20;
begin
inherited;
with lstChecks do
begin
if Index >= uCheckedOrders.Count then Exit;
OCRec := TOCRec(uCheckedOrders.Items[Index]);
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];
with poRect do begin
Result.Top := Top + FontHeightPixel(Font.Handle);
Result.Left := Left - (ciCheckBoxDim div 2) + (Right - Left) div 2;
Result.Right := Result.Left + ciCheckBoxDim;
Result.Bottom := Result.Top + ciCheckBoxDim;
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;
procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject);
var
i, j: Integer;
cnt, i, j, already: Integer;
AnOrderID: string;
OCRec: TOCRec;
DeleteOrderList, DeleteRowList: TstringList;
StillCritical: boolean;
begin
inherited;
for i := lstChecks.Items.Count - 1 downto 0 do if lstChecks.Selected[i] then
DeleteOrderList := TStringList.Create;
DeleteRowList := TStringList.Create;
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
OCRec := TOCRec(uCheckedOrders.Items[i]);
AnOrderID := OCRec.OrderID;
if DeleteCheckedOrder(AnOrderID) then
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);
OCRec.Free;
uCheckedOrders.Delete(i);
lstChecks.Items.Delete(i);
for j := uCheckedOrders.Count - 1 downto 0 do
if TOCRec(uCheckedOrders.Items[j]).OrderID = AnOrderId then
end;
end;
if uCheckedOrders.Count = 0 then Close;
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
StillCritical := false;
for I := 0 to grdChecks.RowCount do
begin
if ((Piece(grdChecks.cells[2,I],U,3) = '1') and not(Piece(grdChecks.Cells[2, i], U, 2) = 'O')) then
begin
StillCritical := true;
break;
end;
end;
if StillCritical = false then
begin
FCritical := false;
lblJustify.Visible := FCritical;
txtJustify.Visible := FCritical;
memNote.Visible := FCritical;
end;
end;
grdChecks.Repaint;
end;
procedure TfrmOCSession.cmdContinueClick(Sender: TObject);
var
i: integer;
Cancel: boolean;
begin
inherited;
Cancel := False;
if FCritical and ((Length(txtJustify.Text) < 2) or not ContainsVisibleChar(txtJustify.Text)) then
begin
InfoBox('A justification for overriding critical order checks is required.',
'Justification Required', MB_OK);
Exit;
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...');
SaveOrderChecksForSession(txtJustify.Text, FCheckList);
StatusText('');
Close;
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;
var Action: TCloseAction);
begin
inherited;
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;
procedure TfrmOCSession.FormShow(Sender: TObject);
begin
inherited;
SetFormPosition(Self); //Get Saved Position & Size of Form
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;
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);
begin
//TfrmAutoSz has defect must call inherited Resize for the resize to function.
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;
procedure TfrmOCSession.txtJustifyKeyDown(Sender: TObject; var Key: Word;
@ -351,4 +932,20 @@ begin
memNote.SelStart := 0;
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.

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

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

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

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

1728
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
Width = 430
Height = 48
TabStop = False
Color = clCream
Ctl3D = True
ParentCtl3D = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
Caption = 'Order'
end
object cmdAccept: TButton [1]
Left = 442

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

@ -43,6 +43,7 @@ type
TResponses = class
private
FDialog: string;
FDialogDisplayName: string;
FResponseList: TList;
FPrompts: TList;
FCopyOrder: string;
@ -98,6 +99,7 @@ type
procedure Update(const APromptID: string; AnInstance: Integer;
const AnIValue, AnEValue: string);
property Dialog: string read FDialog write SetDialog;
property DialogDisplayName: string read FDialogDisplayName write FDialogDisplayName;
property DisplayGroup: Integer read FDisplayGroup write FDisplayGroup;
property CopyOrder: string read FCopyOrder write SetCopyOrder;
property EditOrder: string read FEditOrder; // write SetEditOrder;
@ -644,14 +646,18 @@ begin
if EditOrder <> '' then DupORIFN := EditOrder;
if CopyOrder <> '' then DupORIFN := CopyOrder;
//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
for i := 0 to FResponseList.Count - 1 do
begin
with TResponse(Items[i]) do
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')
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
@ -661,6 +667,14 @@ begin
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;
AStartDtTm := IValueFor('START', 1);
end;
@ -1137,6 +1151,13 @@ var
end;
ExpandOrderObjects(tmp, HasObjects);
FOrderContainsObjects := FOrderContainsObjects or HasObjects;
if frmODBase.FAbortOrder then
begin
SetTemplateDialogCanceled(FALSE);
Exit;
end;
if IEN <> 0 then
begin
// template will execute on copy order if commented out (tried to eliminate for CSV v22, RV)
@ -1154,6 +1175,8 @@ var
else
CheckBoilerplate4Fields(tmp, cptn);
List.Text := tmp;
if WasTemplateDialogCanceled then frmODBase.FAbortOrder := True;
end;
begin
@ -1300,6 +1323,8 @@ end;
procedure TfrmODBase.OrderMessage(const AMessage: string);
{Caller needs to set pnlMessage.TabOrder}
begin
//TDP - Added pnlMessage.Caption for screen reader readability
pnlMessage.Caption := 'Informational Message.';
memMessage.Lines.SetText(PChar(AMessage));
//begin CQ: 2640
memMessage.SelStart := 0; // Put at first character
@ -1322,6 +1347,7 @@ procedure TfrmODBase.SetupDialog(OrderAction: Integer; const ID: string);
begin
FOrderAction := OrderAction;
FAbortOrder := False;
SetTemplateDialogCanceled(False); //wat/jh CQ 20061
case OrderAction of
ORDER_NEW: {nothing};
ORDER_EDIT: Responses.SetEditOrder(ID);
@ -1467,7 +1493,7 @@ begin
try
StatusText('Order Checking...');
Responses.BuildOCItems(OIList, StartDtTm, FillerID);
OrderChecksOnAccept(Responses.OrderChecks, FillerID, StartDtTm, OIList, DupORIFN);
OrderChecksOnAccept(Responses.OrderChecks, FillerID, StartDtTm, OIList, DupORIFN,'0');
DupORIFN := '';
StatusText('');
Result := AcceptOrderWithChecks(Responses.OrderChecks);
@ -1489,8 +1515,8 @@ var
//thisSourceOrder: TOrder;
begin
Result := True;
Validate(ErrMsg);
IsDelayOrder := False;
Validate(ErrMsg);
if Length(ErrMsg) > 0 then
begin
InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
@ -1499,6 +1525,12 @@ begin
end;
if not AcceptOrderChecks then
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
InitDialog // ClearDialogControls is in InitDialog
else
@ -1540,8 +1572,9 @@ begin
then CanSign := CH_SIGN_YES
else CanSign := CH_SIGN_NA;
if NewOrder.Signature = OSS_NOT_REQUIRE then CanSign := CH_SIGN_NA;
if NewOrder.EventPtr <> '' then IsDelayOrder := True;
Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False,IsDelayOrder);
if (NewOrder.EventPtr <> '') and (GetEventDefaultDlg(responses.FEventIFN) <> InttoStr(Responses.QuickOrder)) then
IsDelayOrder := True;
Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False, IsDelayOrder);
UBAGlobals.TargetOrderID := NewOrder.ID;
@ -1710,7 +1743,11 @@ begin
inherited;
//self.Responses.Cancel := False;
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 = ORDER_QUICK then Exit; // should this be here??
if frmFrame.ContextChanging then

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

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

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

@ -234,12 +234,21 @@ const
TX_TFQTY = 'A quantity must be entered for ';
TX_TFAMT = 'The quantity is invalid for ';
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 +
' Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H.' + CRLF +
' May also input 100CC/HR X 16 for 16 hours. Valid quantity for powder form' + CRLF +
' product can be "# GRAMS" as 20 G, GRAMS, or GMS, or as 1 PKG or 1 U and the' + CRLF +
' frequency (e.g. 20 GRAMS/DAY or 1 PKG/TID).';
// CQ #15833 - Removed references of 'c' and 'cc', changed 100CC example to 100ML - JCS
TX_HLPQTY = CRLF + 'Valid entries for quantity:' + CRLF + CRLF +
'Units K for Kcals; M for ml; O for oz.; U for units (e.g. cans), PKG' + CRLF +
'Frequency DAILY HOUR QH BID TID QID Q2H Q3H Q4H Q6H' + CRLF + CRLF +
'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_ELTIME = 'A meal time must be selected.';
TX_ELNOSTART = 'A valid start date must be entered.';

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

@ -1,12 +1,23 @@
inherited frmODGen: TfrmODGen
Left = 223
Top = 290
Height = 295
Caption = 'frmODGen'
ExplicitLeft = 223
ExplicitTop = 290
ExplicitHeight = 295
PixelsPerInch = 96
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
Top = 0
Width = 520
@ -14,9 +25,17 @@ inherited frmODGen: TfrmODGen
Align = alTop
TabOrder = 4
end
inherited cmdAccept: TButton
Top = 209
ExplicitTop = 209
end
inherited cmdQuit: TButton
Top = 219
ExplicitTop = 219
Top = 234
ExplicitTop = 234
end
inherited pnlMessage: TPanel
Top = 191
ExplicitTop = 191
end
inherited amgrMain: TVA508AccessibilityManager
Data = (
@ -25,7 +44,8 @@ inherited frmODGen: TfrmODGen
'Status = stsDefault')
(
'Component = memOrder'
'Status = stsDefault')
'Label = lblOrderSig'
'Status = stsOK')
(
'Component = cmdAccept'
'Status = stsDefault')
@ -42,4 +62,10 @@ inherited frmODGen: TfrmODGen
'Component = frmODGen'
'Status = stsDefault'))
end
object VA508CompMemOrder: TVA508ComponentAccessibility
Component = memOrder
OnStateQuery = VA508CompMemOrderStateQuery
Left = 96
Top = 232
end
end

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

@ -21,9 +21,12 @@ type
TfrmODGen = class(TfrmODBase)
sbxMain: TScrollBox;
lblOrderSig: TLabel;
VA508CompMemOrder: TVA508ComponentAccessibility;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure cmdAcceptClick(Sender: TObject);
procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
private
FilterOut: boolean;
TsID: string; //treating specialty id
@ -34,16 +37,17 @@ type
procedure LookupNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer);
procedure PlaceControls;
procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TrimAllMemos;
function SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl): Boolean;
protected
FFormCloseCalled : Boolean;
FCharHt: Integer;
@ -242,6 +246,13 @@ begin
if FFirstCtrl <> nil then ActiveControl := FFirstCtrl;
end;
procedure TfrmODGen.VA508CompMemOrderStateQuery(Sender: TObject;
var Text: string);
begin
inherited;
Text := memOrder.Text;
end;
procedure TfrmODGen.Validate(var AnErrMsg: string);
var
i: Integer;
@ -327,22 +338,22 @@ begin
DialogCtrl.Required := DialogItem.Required;
DialogCtrl.Preserve := Length(DialogItem.EDefault) > 0;
case DialogItem.DataType of
'D': PlaceDateTime(DialogCtrl, DialogItem);
'F': PlaceFreeText(DialogCtrl, DialogItem);
'D': PlaceDateTime(DialogCtrl, DialogItem, I);
'F': PlaceFreeText(DialogCtrl, DialogItem, i);
'H': PlaceHidden(DialogCtrl, DialogItem);
'N': PlaceNumeric(DialogCtrl, DialogItem);
'P': PlaceLookup(DialogCtrl, DialogItem);
'R': PlaceDateTime(DialogCtrl, DialogItem);
'S': PlaceSetOfCodes(DialogCtrl, DialogItem);
'W': PlaceMemo(DialogCtrl, DialogItem);
'Y': PlaceYesNo(DialogCtrl, DialogItem);
'N': PlaceNumeric(DialogCtrl, DialogItem, i);
'P': PlaceLookup(DialogCtrl, DialogItem, i);
'R': PlaceDateTime(DialogCtrl, DialogItem, i);
'S': PlaceSetOfCodes(DialogCtrl, DialogItem, i);
'W': PlaceMemo(DialogCtrl, DialogItem, i);
'Y': PlaceYesNo(DialogCtrl, DialogItem, i);
end;
FDialogCtrlList.Add(DialogCtrl);
if (DialogCtrl.Editor <> nil) and (FFirstCtrl = nil) then FFirstCtrl := DialogCtrl.Editor;
end;
end;
procedure TfrmODGen.PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TfrmODGen.PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const
NUM_CHAR = 22;
begin
@ -353,6 +364,8 @@ begin
Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
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
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TORDateBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
TORDateBox(Editor).Text := DialogItem.EDefault;
TORDateBox(Editor).Hint := DialogItem.HelpText;
TORDateBox(Editor).Caption := DialogItem.Prompt;
@ -363,7 +376,7 @@ begin
end;
end;
procedure TfrmODGen.PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TfrmODGen.PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
begin
with DialogCtrl do
begin
@ -373,6 +386,8 @@ begin
sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
HT_FRAME * FCharHt);
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).Hint := DialogItem.HelpText;
TCaptionEdit(Editor).Caption := DialogItem.Prompt;
@ -383,7 +398,7 @@ begin
end;
end;
procedure TfrmODGen.PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TfrmODGen.PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const
NUM_CHAR = 16;
begin
@ -393,6 +408,8 @@ begin
Editor.Parent := sbxMain;
Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
TEdit(Editor).MaxLength := NUM_CHAR;
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
TEdit(Editor).Text := DialogItem.EDefault;
TEdit(Editor).Hint := DialogItem.HelpText + '|' + DialogItem.Domain;
TCaptionEdit(Editor).Caption := DialogItem.Prompt;
@ -403,7 +420,7 @@ begin
end;
end;
procedure TfrmODGen.PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TfrmODGen.PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const
NUM_CHAR = 32;
var
@ -416,6 +433,8 @@ begin
TORComboBox(Editor).Style := orcsDropDown;
TORComboBox(Editor).ListItemsOnly := True;
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);
x := DialogItem.Domain;
repeat
@ -426,7 +445,7 @@ begin
until Length(x) = 0;
TORComboBox(Editor).SelectByID(DialogItem.IDefault);
//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;
TORComboBox(Editor).OnChange := ControlChange;
PlaceLabel(DialogCtrl, DialogItem);
@ -434,7 +453,7 @@ begin
end;
end;
procedure TfrmODGen.PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TfrmODGen.PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const
NUM_CHAR = 9;
begin
@ -445,12 +464,14 @@ begin
TORComboBox(Editor).Style := orcsDropDown;
TORComboBox(Editor).ListItemsOnly := True;
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);
TORComboBox(Editor).Items.Add('0^No');
TORComboBox(Editor).Items.Add('1^Yes');
TORComboBox(Editor).SelectByID(DialogItem.IDefault);
//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;
TORComboBox(Editor).OnChange := ControlChange;
PlaceLabel(DialogCtrl, DialogItem);
@ -458,7 +479,7 @@ begin
end;
end;
procedure TfrmODGen.PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TfrmODGen.PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const
NUM_CHAR = 32;
var
@ -481,8 +502,10 @@ begin
TORComboBox(Editor).ListItemsOnly := True;
TORComboBox(Editor).Pieces := '2';
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
TORComboBox(Editor).Hint := DialogItem.HelpText + '|' + XRef + #9 + GblRef + #9 +
TORComboBox(Editor).RpcCall := DialogItem.HelpText + '|' + XRef + #9 + GblRef + #9 +
DialogItem.ScreenRef;
if ( compareText(TsID,DialogItem.Id)=0 ) or (compareText(TSDomain,DialogItem.Domain)=0)then
begin
@ -537,14 +560,14 @@ var
XRef, GblRef, ScreenRef: string;
begin
inherited;
XRef := Piece(TORComboBox(Sender).Hint, '|', 2);
XRef := Piece(TORComboBox(Sender).RpcCall, '|', 2);
GblRef := Piece(XRef, #9, 2);
ScreenRef := Piece(XRef, #9, 3);
XRef := Piece(XRef, #9, 1);
TORComboBox(Sender).ForDataUse(SubsetOfEntries(StartFrom, Direction, XRef, GblRef, ScreenRef));
end;
procedure TfrmODGen.PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
procedure TfrmODGen.PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
const
NUM_LINES = 3;
begin
@ -555,6 +578,8 @@ begin
Editor.SetBounds(FEditorLeft, FEditorTop,
sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
(FCharHt * NUM_LINES) + HT_FRAME);
SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
// TCaptionMemo(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
TMemo(Editor).Text := DialogItem.EDefault;
TMemo(Editor).Hint := DialogItem.HelpText;
TCaptionMemo(Editor).Caption := DialogItem.Prompt;
@ -573,14 +598,19 @@ begin
end;
procedure TfrmODGen.PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
var
ht: integer;
begin
with DialogCtrl do
begin
Prompt := TStaticText.Create(Self);
Prompt.Parent := sbxMain;
Prompt.Caption := DialogItem.Prompt;
ht := Prompt.Height; // CQ#15849
if ht < FCharHt then
ht := FCharHt;
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.Visible := True;
end;
@ -603,8 +633,8 @@ end;
procedure TfrmODGen.cmdAcceptClick(Sender: TObject);
begin
inherited;
Application.ProcessMessages;
TrimAllMemos;
Application.ProcessMessages;
end;
procedure TfrmODGen.ControlChange(Sender: TObject);
@ -631,5 +661,30 @@ begin
memOrder.Text := Responses.OrderText;
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.

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

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

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

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

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

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

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

@ -44,6 +44,15 @@ type
lblFirstDose: TVA508StaticText;
txtAllIVRoutes: 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 tabFluidChange(Sender: TObject);
procedure cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction,
@ -58,10 +67,8 @@ type
procedure cmdRemoveClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure txtSelectedExit(Sender: TObject);
procedure cboSelectedExit(Sender: TObject);
procedure ControlChange(Sender: TObject);
procedure txtSelectedChange(Sender: TObject);
procedure cboSelectedChange(Sender: TObject);
procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState);
procedure FormKeyDown(Sender: TObject; var Key: Word;
@ -93,6 +100,34 @@ type
procedure txtAllIVRoutesClick(Sender: TObject);
procedure cboRouteClick(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
FInpatient: Boolean;
FNSSAdminTime: string;
@ -101,13 +136,13 @@ type
OAddIEN: integer;
OSchedule: string;
oAdmin: string;
Action: integer;
OrderIEN: string;
FAdminTimeText: string;
JAWSON: boolean;
FOriginalDurationType: integer;
FOriginalInfusionType: integer;
FInitialOrderID: boolean;
FIVTypeDefined: boolean;
//FInitialOrderID: boolean;
procedure SetValuesFromResponses;
procedure DoSetFontSize( FontSize: integer);
procedure ClickOnGridCell;
@ -118,7 +153,11 @@ type
procedure DisplayDoseNow(Status: boolean);
procedure UpdateDuration(SchType: string);
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
OrdAction: integer;
procedure InitDialog; override;
procedure SetupDialog(OrderAction: Integer; const ID: string); override;
procedure Validate(var AnErrMsg: string); override;
@ -151,6 +190,7 @@ type
Amount: Integer;
Units: string;
Volumes: string;
AddFreq: string;
end;
const
@ -167,6 +207,9 @@ const
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_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 }
@ -199,6 +242,7 @@ begin
Close;
Exit;
end;
OrdAction := -1;
DoSetFontSize(MainFontSize);
FillerID := 'PSIV'; // does 'on Display' order check **KCM**
StatusText('Loading Dialog Definition');
@ -220,15 +264,36 @@ end;
procedure TfrmODMedIV.FormResize(Sender: TObject);
var
bottom: integer;
isNewOrder: boolean;
begin
inherited;
if OrdAction in [ORDER_COPY, ORDER_EDIT] then isNewOrder := false
else isNewOrder := True;
with grdSelected do
begin
ColWidths[1] := Canvas.TextWidth(' 10000 ') + 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;
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.cboInfusionTime.SelLength := 0;
self.cboDuration.SelLength := 0;
@ -242,9 +307,10 @@ begin
self.lblFirstDose.Width := TextWidthByFont(self.lblFirstDose.Font.Handle, self.lblFirstDose.Caption + ' ');
self.lblAdminTime.Top := self.chkDoseNow.Top + self.chkDoseNow.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
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;
end;
end;
@ -261,6 +327,8 @@ begin
//grdSelected.Selection := NOSELECTION;
//FRouteConflict := False;
//lblTypeHelp.Hint := IVTypeHelpText;
ClearAllFields;
//FIVTypeDefined := false;
lblType.Hint := IVTypeHelpText;
cboType.Hint := IVTYpeHelpText;
with grdSelected do for i := 0 to RowCount - 1 do
@ -285,7 +353,6 @@ begin
LoadSchedules(cboSchedule.Items, patient.Inpatient);
//if (Patient.Inpatient) and (cboSchedule.Items.IndexOfName('Other')<0) then
if cboSchedule.Items.IndexOf('Other') = -1 then cboSchedule.Items.Add('OTHER');
cboSchedule.Enabled := False;
lblschedule.Enabled := False;
if cboInfusionTime.Items.Count = 0 then
@ -309,6 +376,13 @@ begin
if (chkDoseNow.Visible = true) and (chkDoseNow.Checked = true) then chkDoseNow.Checked := false;
chkDoseNow.Visible := 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;
tabFluid.TabIndex := 0;
tabFluidChange(Self); // this makes cboSolution visible
@ -329,6 +403,8 @@ begin
OSchedule := '';
oAdmin := '';
self.txtAllIVRoutes.Visible := false;
memorder.text := '';
memOrder.Lines.Clear;
end;
function TfrmODMedIV.IVTypeHelpText: string;
@ -340,6 +416,12 @@ begin
'Examples:' + CRLF + 'Continuous = Infusion/drip' + CRLF + 'Intermittent = IVP/IVPB';
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);
var
str: string;
@ -454,10 +536,54 @@ begin
else self.lblAdminTime.TabStop := false;
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);
var
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;
procedure SetError(const x: string);
@ -498,6 +624,24 @@ begin
Exit;
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;
@ -573,13 +717,19 @@ begin
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);
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);
end;
if txtXDuration.Text = '' then
begin
if AnErrMsg = '' then self.FInitialOrderID := True;
exit;
if AnErrMsg = '' then exit;
//if AnErrMsg = '' then self.FInitialOrderID := True;
//exit;
end;
Len := Length(txtXDuration.Text);
if LeftStr(txtXDuration.Text,1) <> '.' then
@ -606,7 +756,7 @@ begin
else if (Value < 0) or (Value > 2000000) then
SetError('Duration with a unit of "doses" must be greater then 0 and less then 2000000');
end;
if AnErrMsg = '' then self.FInitialOrderID := True;
//if AnErrMsg = '' then self.FInitialOrderID := True;
end;
@ -628,17 +778,19 @@ end;
procedure TfrmODMedIV.SetValuesFromResponses;
var
x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute: string;
AnInstance, i, idx: Integer;
AResponse: TResponse;
x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute, PreAddFreq: string;
AnInstance, i, idx, j: Integer;
AResponse, AddFreqResp: TResponse;
AnIVComponent: TIVComponent;
AllIVRoute: TStringList;
PQO: boolean;
begin
Changing := True;
self.FInitialOrderID := false;
//self.FInitialOrderID := false;
with Responses do
begin
SetControl(cboType, 'TYPE', 1);
if cboType.ItemIndex > -1 then FIVTypeDefined := True;
FInpatient := OrderForInpatient;
AnInstance := NextInstance('ORDERABLE', 0);
while AnInstance > 0 do
@ -681,6 +833,7 @@ begin
if AnIVComponent.Amount <> 0 then
Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
Cells[2, RowCount - 1] := AnIVComponent.Units;
Cells[3, RowCount - 1] := 'N/A';
end;
end;
AResponse := FindResponseByName('VOLUME', AnInstance);
@ -720,6 +873,19 @@ begin
AnIVComponent.Amount := StrToIntDef(Piece(x, U, 2), 0);
AnIVComponent.Units := Piece(x, U, 1);
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
begin
if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
@ -728,6 +894,8 @@ begin
if AnIVComponent.Amount <> 0 then
Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
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;
AResponse := FindResponseByName('STRENGTH', AnInstance);
@ -802,7 +970,7 @@ begin
SetSchedule(tempSch);
//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 (Action in [ORDER_COPY, ORDER_EDIT]) then
if (OrdAction in [ORDER_COPY, ORDER_EDIT]) then
begin
TempOrder := Piece(OrderIEN,';',1);
TempOrder := Copy(tempOrder, 2, Length(tempOrder));
@ -811,7 +979,7 @@ begin
AResponse := Responses.FindResponseByName('ADMIN', 1);
if AResponse <> nil then AdminTime := AResponse.EValue;
//lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
if cboSchedule.ItemIndex > -1 then
if (cboSchedule.ItemIndex > -1) and (AdminTime <> '') then
begin
tmpSch := cboSchedule.Items.Strings[cboSchedule.itemindex];
setPiece(tmpSch,U,4,AdminTime);
@ -847,6 +1015,8 @@ begin
cboInfusionTime.Text := 'Minutes';
cboInfusionTime.itemindex := 0;
end;
For j := 0 to grdSelected.RowCount -1 do
grdSelected.Cells[3,j] := 'N/A';
end
else
begin
@ -889,15 +1059,15 @@ end;
procedure TfrmODMedIV.SetupDialog(OrderAction: Integer; const ID: string);
begin
inherited;
Action := OrderAction;
OrdAction := OrderAction;
OrderIEN := id;
self.FInitialOrderID := True;
//self.FInitialOrderID := True;
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
FAdminTimeText := 'Not defined for Clinic Locations';
if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
begin
SetValuesFromResponses;
end;
end;
@ -927,16 +1097,13 @@ end;
procedure TfrmODMedIV.cboSolutionNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer);
var
CurString: string;
begin
inherited;
if (Direction = 1) then
CurString := AnsiUpperCase(StartFrom) + ' ';
cboSolution.ForDataUse(SubSetOfOrderItems(CurString, Direction, 'S.IVB RX'));
cboSolution.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.IVB RX'));
end;
procedure TfrmODMedIV.cbotypeChange(Sender: TObject);
var
i: integer;
begin
inherited;
//if (self.cbotype.Text = 'Intermittent') or (self.cboType.itemIndex = 1) then
@ -954,7 +1121,16 @@ begin
chkPRN.Enabled := True;
lblInfusionRate.Caption := 'Infuse Over Time (Optional)';
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
//else if (self.cbotype.Text = 'Continuous') or (self.cboType.itemIndex = 0) then
else
@ -974,11 +1150,36 @@ begin
lblAdminTime.Visible := false;
updateDuration('');
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;
FIVTypeDefined := True;
self.txtRate.Text := '';
ControlChange(Sender);
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);
Const
T = '"';
@ -986,11 +1187,13 @@ Const
T2 = #13#13'The first order''s administrative schedule is "';
T3 = #13'The second order''s administrative schedule is "';
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"';
T2A = ' in addition to the one you are placing for the same medication.';
var
medNm: string;
theSch: string;
ordPriority: string;
//SchID: integer;
begin
inherited;
@ -999,10 +1202,12 @@ begin
medNm := 'Test';
//SchID := cboSchedule.ItemIndex;
theSch := cboSchedule.Text;
ordPriority := cboPriority.SelText;
if length(theSch)>0 then
begin
//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
chkDoseNow.Checked := False;
Exit;
@ -1088,17 +1293,19 @@ begin
Cells[0, RowCount - 1] := AnIVComponent.Name;
Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
Cells[2, RowCount - 1] := AnIVComponent.Units;
Cells[3, RowCount - 1] := 'N/A';
Row := RowCount - 1;
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
tabFluid.TabIndex := 1;
tabFluidChange(Self);
end;
end; *)
end;
Application.ProcessMessages; //CQ: 10157
ClickOnGridCell;
updateRoute;
ClickOnGridCell;
//updateRoute;
ControlChange(Sender);
//updateRoute(routeIEN);
end;
@ -1116,13 +1323,35 @@ end;
procedure TfrmODMedIV.cboAdditiveNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer);
var
CurString: string;
begin
cboAdditive.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.IVA RX'));
end;
procedure TfrmODMedIV.cboAddFreqCloseUp(Sender: TObject);
begin
inherited;
if (Direction = 1) then
CurString := AnsiUpperCase(StartFrom) + ' ';
cboAdditive.ForDataUse(SubSetOfOrderItems(CurString, Direction, 'S.IVA RX'));
with cboAddFreq do
begin
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;
procedure TfrmODMedIV.cboDurationChange(Sender: TObject);
@ -1178,6 +1407,13 @@ begin
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);
begin
inherited;
@ -1231,6 +1467,21 @@ begin
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);
var
AnIVComponent: TIVComponent;
@ -1272,6 +1523,7 @@ begin
Objects[0, RowCount - 1] := AnIVComponent;
Cells[0, RowCount - 1] := AnIVComponent.Name;
Cells[2, RowCount - 1] := AnIVComponent.Units;
Cells[3, RowCount -1] := UpdateAddFreq(AnIVComponent.IEN);
Row := RowCount - 1;
Col := 1;
end;
@ -1301,9 +1553,10 @@ begin
self.cboDuration.ItemIndex := -1;
self.cboDuration.Text := '';
self.txtAllIVRoutes.Visible := false;
self.FInitialOrderID := True;
//self.FInitialOrderID := True;
cbotypeChange(self.cboType);
if self.cboroute.Items.Count > 0 then self.cboRoute.Clear;
FIVTypeDefined := false;
end;
procedure TfrmODMedIV.ClickOnGridCell;
@ -1323,13 +1576,20 @@ var
Show;
SetFocus;
if AControl is TComboBox then //CQ: 10157
begin
TComboBox(AControl).DroppedDown := True;
TControl(self.grdSelected).Enabled := false;
end;
end;
end;
begin
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
if (grdSelected.Col = 2) and (Length(Piece(AnIVComponent.Units, U, 2)) > 0) then
begin
@ -1353,6 +1613,13 @@ begin
txtSelected.Tag := (grdSelected.Col * 256) + grdSelected.Row;
PlaceControl(txtSelected);
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;
procedure TfrmODMedIV.txtSelectedChange(Sender: TObject); // text editor for grid
@ -1375,9 +1642,26 @@ begin
Tag := -1;
Hide;
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;
procedure TfrmODMedIV.cboScheduleChange(Sender: TObject);
var
othSch: string;
idx: integer;
begin
inherited;
if self.txtXDuration.Enabled = true then
@ -1385,14 +1669,28 @@ begin
self.txtXDuration.Text := '';
self.cboDuration.ItemIndex := -1;
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);
end;
procedure TfrmODMedIV.cboScheduleClick(Sender: TObject);
var
othSch: string;
idx, i : integer;
idx: integer;
begin
inherited;
if cboSchedule.ItemIndex = cboSchedule.Items.IndexOf('Other') then
@ -1401,14 +1699,7 @@ begin
if length(trim(othSch)) > 1 then
begin
cboSchedule.Items.Add(othSch + U + U + NSSScheduleType + U + NSSAdminTime);
idx := -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);
idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
cboSchedule.ItemIndex := idx;
end;
end
@ -1430,27 +1721,48 @@ begin
cboSchedule.Text := '';
cboSchedule.SetFocus;
end;
if (cboSchedule.ItemIndex > -1) and (cboSchedule.Text = '') then cboSchedule.ItemIndex := -1;
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
inherited;
with cboSelected do
begin
if Tag < 0 then Exit;
grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
end;
ControlChange(Sender);
end;
procedure TfrmODMedIV.cboSelectedExit(Sender: TObject);
begin
inherited;
with cboSelected do
begin
grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
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.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;
@ -1527,6 +1839,8 @@ begin
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[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);
end; {if Fluid A}
end; {with AnIVComponent}
@ -1557,8 +1871,9 @@ begin
xlimEx := '';
end;
end;
if cboType.Text = 'Intermittent' then iType := 'I'
else iType := 'C';
if (cboType.ItemIndex > -1) and (cboType.Items.Strings[cboType.ItemIndex] = 'Intermittent') then iType := 'I'
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('ROUTE',1,cboRoute.ItemID,cboRoute.Text);
tmpSch := UpperCase(Trim(cboSchedule.Text));
@ -1634,12 +1949,10 @@ var
aSchedule: string;
begin
aSchedule := '';
if not ShowOtherSchedule(aSchedule) then
begin
cboSchedule.ItemIndex := -1;
cboSchedule.Text := '';
end
else
cboSchedule.DroppedDown := false;
if ShowOtherSchedule(aSchedule) then
begin
Result := Piece(aSchedule,U,1);
NSSAdminTime := Piece(aschedule,u,2);
@ -1651,12 +1964,28 @@ procedure TfrmODMedIV.grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer;
State: TGridDrawState);
begin
inherited;
if Sender = ActiveControl then Exit;
if not (gdSelected in State) then Exit;
//if Sender = ActiveControl then Exit;
//if not (gdSelected in State) then Exit;
with Sender as TStringGrid do
begin
Canvas.Brush.Color := Color;
if State = [gdSelected..gdFocused] then
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]);
end;
end;
@ -1697,6 +2026,13 @@ begin
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);
begin
inherited;
@ -1781,6 +2117,12 @@ begin
cboSchedule.ItemIndex := idx;
exit;
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)
if (Pos('@', x) > 0) then
begin
@ -1804,7 +2146,6 @@ begin
begin
//tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5);
tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx];
cboSchedule.Items.Add(tempSch);
cboSchedule.Text := (Piece(tempSch,U,1));
cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch, U, 1));
chkPRN.Checked := True;
@ -1885,6 +2226,13 @@ begin
ControlChange(Sender);
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);
begin
if SchType = 'O' then
@ -1908,7 +2256,7 @@ var
AnIVComponent: TIVComponent;
i: integer;
OrderIds, TempIVRoute: TStringList;
Default: boolean;
//Default: boolean;
begin
if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True;
TempIVRoute := TStringList.Create;
@ -1927,19 +2275,21 @@ begin
end;
if OrderIds.Count > 0 then
begin
if (self.FInitialOrderID = True) and (self.grdSelected.RowCount = 1) then Default := True
else Default := False;
LoadDosageFormIVRoutes(self.cboRoute.Items, OrderIds, Default);
if default = True then
begin
//if (self.FInitialOrderID = True) and (self.grdSelected.RowCount = 1) then Default := True
//else Default := False;
LoadDosageFormIVRoutes(self.cboRoute.Items, OrderIds);
//if default = True then
// begin
for I := 0 to cboRoute.items.Count - 1 do
begin
if Piece(cboRoute.Items.Strings[i], U, 5) = 'D' then
begin
cboRoute.ItemIndex := i;
break;
end;
self.FInitialOrderID := false;
end;
// self.FInitialOrderID := false;
//end;
OrderIds.Free;
end;
if TempIVRoute.Count > 0 then
@ -1953,13 +2303,14 @@ end;
procedure TfrmODMedIV.txtAllIVRoutesClick(Sender: TObject);
var
i: integer;
i: integer;
msg : String;
begin
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.'
+ #13#10 + 'Click OK to launch the Expanded Med Route List.',
mtInformation, [mbOK, mbCancel],0) = mrOK then
+ #13#10 + 'Click OK to launch the Expanded Med Route List.';
if ShowMsg(msg, smiInfo, smbOKCancel) = smrOk then
begin
for I := 0 to cboRoute.Items.Count - 1 do if cboRoute.Items.Strings[i] = U + 'OTHER' then break;
cboRoute.ItemIndex := i;
@ -1970,13 +2321,14 @@ end;
procedure TfrmODMedIV.txtNSSClick(Sender: TObject);
var
i: integer;
i: integer;
msg : String;
begin
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.'
+ #13#10 + 'Click OK to launch schedule builder',
mtInformation, [mbOK, mbCancel],0) = mrOK then
+ #13#10 + 'Click OK to launch schedule builder';
if ShowMsg(msg, smiInfo, smbOKCancel) = smrOK then
begin
//cboSchedule.Items.Add(U + 'OTHER');
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
Top = 183
Width = 632
Height = 536
Height = 542
Caption = 'Document Herbal/OTC/Non-VA Medications'
Constraints.MinHeight = 365
ExplicitWidth = 632
ExplicitHeight = 536
ExplicitHeight = 542
PixelsPerInch = 96
TextHeight = 13
inherited memOrder: TCaptionMemo
Left = 0
Top = 461
Top = 467
Width = 525
Anchors = [akLeft, akRight, akBottom]
Constraints.MinWidth = 25
TabOrder = 4
ExplicitLeft = 0
ExplicitTop = 461
ExplicitTop = 467
ExplicitWidth = 525
end
object pnlMeds: TPanel [1]
Left = 6
Top = 34
Width = 593
Height = 415
Height = 421
Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone
Caption = 'pnlMeds'
@ -72,7 +72,7 @@ inherited frmODMedNVA: TfrmODMedNVA
Left = 0
Top = 137
Width = 593
Height = 278
Height = 284
Align = alClient
Columns = <
item
@ -98,7 +98,7 @@ inherited frmODMedNVA: TfrmODMedNVA
end
object txtMed: TEdit [2]
Left = 5
Top = 6
Top = 12
Width = 596
Height = 21
Anchors = [akLeft, akTop, akRight]
@ -112,9 +112,9 @@ inherited frmODMedNVA: TfrmODMedNVA
end
object pnlFields: TPanel [3]
Left = 3
Top = 30
Top = 43
Width = 624
Height = 428
Height = 423
Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone
Enabled = False
@ -124,14 +124,14 @@ inherited frmODMedNVA: TfrmODMedNVA
Left = 0
Top = 0
Width = 624
Height = 264
Height = 259
Align = alClient
Constraints.MinHeight = 80
Constraints.MinWidth = 30
TabOrder = 0
DesignSize = (
624
264)
259)
object lblRoute: TLabel
Left = 349
Top = 23
@ -171,7 +171,7 @@ inherited frmODMedNVA: TfrmODMedNVA
OnClick = lblGuidelineClick
end
object tabDose: TTabControl
Left = -7
Left = 1
Top = 19
Width = 175
Height = 17
@ -187,7 +187,7 @@ inherited frmODMedNVA: TfrmODMedNVA
Left = 8
Top = 36
Width = 383
Height = 222
Height = 217
Anchors = [akLeft, akTop, akRight, akBottom]
Style = orcsSimple
AutoSelect = True
@ -209,13 +209,14 @@ inherited frmODMedNVA: TfrmODMedNVA
OnChange = cboDosageChange
OnClick = cboDosageClick
OnExit = cboDosageExit
OnKeyUp = cboDosageKeyUp
CharsNeedMatch = 1
end
object cboRoute: TORComboBox
Left = 355
Top = 36
Width = 114
Height = 223
Height = 218
Anchors = [akTop, akRight, akBottom]
Style = orcsSimple
AutoSelect = True
@ -237,14 +238,14 @@ inherited frmODMedNVA: TfrmODMedNVA
TabOrder = 2
OnChange = cboRouteChange
OnClick = ControlChange
OnExit = cboRouteExit
OnKeyUp = cboRouteKeyUp
CharsNeedMatch = 1
end
object cboSchedule: TORComboBox
Left = 467
Top = 36
Top = 37
Width = 157
Height = 223
Height = 218
Anchors = [akTop, akRight, akBottom]
Style = orcsSimple
AutoSelect = True
@ -264,7 +265,7 @@ inherited frmODMedNVA: TfrmODMedNVA
TabOrder = 3
OnChange = cboScheduleChange
OnClick = cboScheduleClick
OnExit = cboScheduleExit
OnKeyUp = cboScheduleKeyUp
CharsNeedMatch = 1
end
object chkPRN: TCheckBox
@ -282,7 +283,7 @@ inherited frmODMedNVA: TfrmODMedNVA
end
object pnlBottom: TPanel
Left = 0
Top = 264
Top = 259
Width = 624
Height = 164
Align = alBottom
@ -387,7 +388,7 @@ inherited frmODMedNVA: TfrmODMedNVA
end
object btnSelect: TButton [4]
Left = 539
Top = 463
Top = 469
Width = 72
Height = 21
Anchors = [akRight, akBottom]
@ -399,23 +400,23 @@ inherited frmODMedNVA: TfrmODMedNVA
end
inherited cmdAccept: TButton
Left = 540
Top = 463
Top = 469
Width = 69
Anchors = [akRight, akBottom]
TabOrder = 6
Visible = False
ExplicitLeft = 540
ExplicitTop = 463
ExplicitTop = 469
ExplicitWidth = 69
end
inherited cmdQuit: TButton
Left = 546
Top = 489
Top = 495
Width = 49
Anchors = [akRight, akBottom]
TabOrder = 7
ExplicitLeft = 546
ExplicitTop = 489
ExplicitTop = 495
ExplicitWidth = 49
end
inherited pnlMessage: TPanel
@ -435,7 +436,8 @@ inherited frmODMedNVA: TfrmODMedNVA
'Status = stsDefault')
(
'Component = txtMed'
'Status = stsDefault')
'Text = Medication'
'Status = stsOK')
(
'Component = pnlFields'
'Status = stsDefault')
@ -483,7 +485,8 @@ inherited frmODMedNVA: TfrmODMedNVA
'Status = stsDefault')
(
'Component = memOrder'
'Status = stsDefault')
'Text = Order Sig'
'Status = stsOK')
(
'Component = cmdAccept'
'Status = stsDefault')

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

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

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

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

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

@ -188,6 +188,17 @@ type
procedure cboXSequenceExit(Sender: TObject);
procedure cboXSequenceEnter(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);
private
FCloseCalled : Boolean;
@ -288,7 +299,7 @@ type
procedure UpdateStartExpires(const CurSchedule: string);
procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
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);
procedure UpdateDurationControls( FreeText: boolean);
function DisableDefaultButton(Control: TWinControl): boolean;
@ -396,6 +407,7 @@ const
FLD_NOW_NM = 76;
FLD_COMMENT = 80;
FLD_PTINSTR = 85;
FLD_DRUG_ID_INT = 90;
{dosage type tab index values}
TI_DOSE = 0;
TI_RATE = 99;
@ -541,6 +553,10 @@ begin
x := 'IVM RX';
end;
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);
lstAll.Items.Count := ListCount;
FMedCache := TObjectList.Create;
@ -613,8 +629,8 @@ end;
procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
var
AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime: string;
ix: integer;
AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime, x: string;
i, ix: integer;
LocChange: boolean;
AResponse: TResponse;
@ -630,7 +646,7 @@ begin
end;
//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.
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
FIsQuickOrder := True;
FQOInitial := True;
@ -646,6 +662,17 @@ begin
begin
Changing := True;
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
(uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit;
if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
@ -671,7 +698,7 @@ begin
nsSch := TResponse(Responses.theList[ix]).EVALUE;
if length(nsSch) > 0 then
begin
SetSchedule(nsSch);
SetSchedule(UpperCase(nsSch));
{cboSchedule.SelectByID(nsSch);
if cboSchedule.ItemIndex < 0 then
begin
@ -693,13 +720,13 @@ begin
begin
AResponse := Responses.FindResponseByName('ADMIN', 1);
if AResponse <> nil then AdminTime := AResponse.EValue;
if self.cboSchedule.ItemIndex > -1 then
if (self.cboSchedule.ItemIndex > -1) and (AdminTime <> '') then
begin
tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
SetPiece(tempSchString,U,4,AdminTime);
self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
end;
if self.tabDose.TabIndex = TI_COMPLEX then
if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) and (AdminTime <> '') then
begin
if self.cboXSchedule.ItemIndex > -1 then
begin
@ -721,7 +748,7 @@ begin
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) then
begin
if self.cboXSchedule.ItemIndex > -1 then
begin
@ -741,7 +768,29 @@ begin
if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText);
end;
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;
if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and
(self.cboSchedule.ItemIndex > -1) then
@ -761,6 +810,7 @@ begin
Caption := Text;
memComment.Clear; // sometimes the sig is in the comment
end;
FQOInitial := False;
ControlChange(Self);
if Self.IsSupply then
btnSelect.Enabled := False;
@ -817,12 +867,21 @@ var
ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance);
ADrug := ValueOfResponse(FLD_DRUG_ID, AnInstance);
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)
else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
then SetError(TX_NO_SCHED);
if Length(tmpX) > 0 then
begin
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
begin
if Pos('"', tmpX) > 0 then SetError(TX_SCH_QUOTE);
@ -855,11 +914,18 @@ begin
cboDosage.SetFocus; //CQ: 7467
end;
if Length(Responses.IValueFor('INSTR', i)) > 60 then
begin
if self.tabDose.TabIndex = TI_COMPLEX then
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;
ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
ValidateSchedule(ValueOfResponse(FLD_SCHEDULE, i), i);
i := Responses.NextInstance('INSTR', i);
@ -888,6 +954,14 @@ begin
SetError(TX_NO_SEQ);
Exit;
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;
if not FInptDlg then // outpatient stuff
@ -1317,9 +1391,12 @@ begin
LoadMedCache(Item.Index, Item.Index);
chunk := GetCacheChunkIndex(Item.Index);
list := TStringList(FMedCache[chunk]);
//This is to make sure that the index that is being used is not outside of the stringlist
If Item.Index mod MED_CACHE_CHUNK_SIZE < list.Count then begin
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;
procedure TfrmODMeds.lstAllDataHint(Sender: TObject; StartIndex,
@ -1414,7 +1491,6 @@ begin
end;
end; *)
FAltChecked := True;
;
SetOnMedSelect; // set up for this medication
SetOnQuickOrder; // insert quick order responses
if Length(txtQuantity.Text)>0 then
@ -1423,6 +1499,7 @@ begin
if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false;
if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then
txtQuantity.Text := QOQuantityStr;
//FQOInitial := False;
end
else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then // orderable item
begin
@ -1452,8 +1529,9 @@ begin
if Pos(' NF', self.MedName) > 0 then
begin
temp := self.MedName;
CheckFormularyOI(MedIEN, temp, FInptDlg);
CheckFormularyOI(medIEN, temp, FInptDlg);
FAltChecked := True;
txtMed.Text := '';
end;
if MedIEN <> txtMed.Tag then
begin
@ -1480,6 +1558,8 @@ begin
end
else ShowMedSelect; // show the selection fields
FNoZERO := False;
if FQOInitial = True then FQOInitial := False;
end;
procedure TfrmODMeds.ResetOnMedChange;
@ -1602,7 +1682,7 @@ begin
//AGP Change 27.72 trying to centralized the schedule setting code
AResponse := Responses.FindResponseByName('SCHEDULE',1);
if (AResponse <> nil) and (AResponse.EValue <> '') then x := AResponse.EValue;
SetSchedule(x);
SetSchedule(UpperCase(x));
(* if x <> '' then
begin
cboSchedule.SelectByID(x);
@ -1715,7 +1795,7 @@ end;
procedure TfrmODMeds.SetOnQuickOrder;
var
AResponse: TResponse;
x,LocRoute,TempSch,DispGrp: string;
x,LocRoute,TempSch,DispGrp, SchType: string;
i, DispDrug: Integer;
begin
// txtMed already set by SetOnMedSelect
@ -1729,20 +1809,16 @@ begin
begin
SetDosage(IValueFor('INSTR', i));
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
grdDoses.Cells[COL_DOSAGE, i] := x;
SetControl(cboRoute, 'ROUTE', i);
with cboRoute do
if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
grdDoses.Cells[COL_ROUTE, i] := x;
if FIsQuickOrder then TempSch := cboSchedule.Text;
SetSchedule(IValueFor('SCHEDULE', i));
if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
begin
cboSchedule.SelectByID(TempSch);
cboSchedule.Text := TempSch;
end;
SetSchedule(UpperCase(IValueFor('SCHEDULE', i)));
if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
x := cboSchedule.Text;
if chkPRN.Checked then x := x + ' PRN';
@ -1754,12 +1830,22 @@ begin
if FInptDlg then
begin
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)
else grdDoses.Cells[COL_ADMINTIME, i] := '';
if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined';
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;
chkPRN.Checked := false;
if IValueFor('CONJ', i) = 'A' then x := 'AND'
else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT'
@ -1778,7 +1864,7 @@ begin
else
SetDosage(IValueFor('INSTR', 1));
SetControl(cboRoute, 'ROUTE', 1);
SetSchedule(IValueFor('SCHEDULE', 1));
SetSchedule(UpperCase(IValueFor('SCHEDULE', 1)));
if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
begin
cboSchedule.SelectByID(TempSch);
@ -1844,7 +1930,7 @@ begin
Responses.FindResponseByName('SC', 1);
end; {if FInptDlg..else}
end; {with}
if FInptDlg then
if (FInptDlg) then
begin
x := ValueOfResponse(FLD_SCHEDULE, 1);
if Length(x) > 0 then UpdateStartExpires(x);
@ -1900,7 +1986,7 @@ begin
btnSelect.Anchors := [akRight, akTop];
btnSelect.Default := False;
cmdAccept.Visible := True;
cmdAccept.Default := True;
cmdAccept.Default := False;
cmdAccept.Left := cmdQuit.Left;
cmdAccept.Top := MemOrder.Top;
btnSelect.TabOrder := txtMed.TabOrder + 1;
@ -1995,6 +2081,7 @@ procedure TfrmODMeds.ShowControlsComplex;
//dosagetxt: string;
begin
tabDose.TabIndex := TI_COMPLEX;
lblAdminSchSetTexT('');
MoveCombo(cboDosage, cboXDosage);
MoveCombo(cboRoute, cboXRoute);
MoveCombo(cboSchedule, cboXSchedule, true); //AGP Changes 26.12 PSI-04-063
@ -2078,9 +2165,15 @@ begin
end;
end;
cboSchedule.ItemIndex := -1;
cboSchedule.Text := '';
if chkPRN.Checked = True then chkPRN.Checked := False;
cboSchedule.SelectByID(x);
if cboSchedule.ItemIndex > -1 then exit;
if (X = ' PRN') or (X = 'PRN') then
begin
chkPRN.Checked := True;
Exit;
end;
// if cboSchedule.ItemIndex < 0 then
//begin
//if NSSchedule then
@ -2432,6 +2525,13 @@ begin
inherited;
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 ----------------------------------- }
procedure TfrmODMeds.cboScheduleClick(Sender: TObject);
@ -2471,8 +2571,9 @@ begin
othSch := CreateOtherScheduel;
if length(trim(othSch)) > 1 then
begin
othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
cboSchedule.Items.Add(othSch);
idx := cboSchedule.Items.IndexOf(OthSch);
idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
cboSchedule.ItemIndex := idx;
end;
end;
@ -2527,6 +2628,29 @@ begin
ControlChange(Sender);
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 -------------------------- }
procedure TfrmODMeds.txtSupplyChange(Sender: TObject);
@ -2741,7 +2865,9 @@ begin
DoseDrug := DoseDrug + U + FDrugID;
for i := 0 to Pred(FAllDoses.Count) do
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
Result := Piece(FAllDoses[i], U, 3);
Break;
@ -3141,7 +3267,7 @@ begin
DoseMinutes := 0;
if Piece(x, ' ', 2) = 'MONTHS' then DoseMinutes := ExtractInteger(x) * 43200;
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) = 'MINUTES' then DoseMinutes := ExtractInteger(x);
// Determine how TotalMinutes should be calculated based on conjunction
@ -3181,7 +3307,7 @@ begin
inherited;
with grdDoses do
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
if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then
begin
@ -3463,6 +3589,7 @@ begin
if grdDoses.Row = Pred(grdDoses.RowCount) then grdDoses.RowCount := grdDoses.RowCount + 1;
DisableDefaultButton(self);
DisableCancelButton(self);
QuantityMessageCheck(cboXDosage.Tag);
end;
procedure TfrmODMeds.cboXDosageChange(Sender: TObject);
@ -3731,6 +3858,12 @@ begin
infoBox(str,'Administration Time Information',MB_OK);
end;
procedure TfrmODMeds.pnlXDurationButtonEnter(Sender: TObject);
begin
inherited;
QuantityMessageCheck(self.grdDoses.Row);
end;
procedure TfrmODMeds.pnlXDurationEnter(Sender: TObject);
begin
inherited;
@ -4159,7 +4292,7 @@ begin
end;
SkipQtyCheck := TRUE;
end;
if FQOInitial = true then FQOInitial := False;
//if FQOInitial = true then FQOInitial := False;
end;
if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then
begin
@ -4184,7 +4317,9 @@ begin
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);
const
UPD_NONE = 0;
@ -4196,9 +4331,8 @@ var
UpdateControl, NewSupply: Integer;
ADrug: string;
SaveChanging: Boolean;
tmpQuty: Double;
tmpQuantity: double;
begin
tmpQuty := 0;
if (tabDose.TabIndex = TI_COMPLEX) and (txtSupply.Tag = 0) and (txtQuantity.Tag = 0) then
begin
// set days supply based on durations
@ -4219,7 +4353,8 @@ begin
(CurSchedule = FLastSchedule) and
(CurDuration = FLastDuration) and
(CurQuantity = FLastQuantity) and
(CurSupply = FLastSupply) then Exit;
(CurSupply = FLastSupply) and
(CurInstruct = FLastInstruct) then Exit;
// exit if supply & quantity have both been directly edited
if (txtSupply.Tag > 0) and (txtQuantity.Tag > 0) then Exit;
// 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
else if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) then UpdateControl := UPD_QUANTITY
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
if txtQuantity.Tag = 0 then UpdateControl := UPD_QUANTITY
else if txtSupply.Tag = 0 then UpdateControl := UPD_SUPPLY;
@ -4238,17 +4373,11 @@ begin
UPD_QUANTITY : begin
if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
begin
FQOInitial := False;
txtQuantity.Text := FloatToStr(CurQuantity);
Exit;
end;
if FIsQuickOrder and (CurQuantity > 0) then
tmpQuty := CurQuantity;
CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
if (tmpQuty > 0) and (CurQuantity <= 0) then
begin
txtQuantity.Text := FloatToStr(tmpQuty);
CurQuantity := tmpQuty;
end else if (CurQuantity >= 0) then
if (CurQuantity >= 0) then
txtQuantity.Text := FloatToStr(CurQuantity);
end;
UPD_SUPPLY : begin
@ -4257,20 +4386,21 @@ begin
end;
UPD_BOTH : begin
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
begin
FQOInitial := False;
txtQuantity.Text := FloatToStr(CurQuantity);
Exit;
end;
if FIsQuickOrder and (CurQuantity > 0) then
tmpQuty := CurQuantity;
CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
if (tmpQuty > 0) and (CurQuantity <= 0) then
(* if FIsQuickOrder and (CurQuantity > 0) and (tmpQuantity = 0) and FQOInitial then
begin
txtQuantity.Text := FloatToStr(tmpQuty);
CurQuantity := tmpQuty;
end else if CurQuantity >= 0 then
txtQuantity.Text := FloatToStr(CurQuantity);
Exit;
end; *)
//CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
CurQuantity := tmpQuantity;
if CurQuantity >= 0 then
txtQuantity.Text := FloatToStr(CurQuantity);
end;
end;
@ -4578,31 +4708,15 @@ begin
if lblAdminTime.Visible then
lblAdminTime.Caption := '';
end;
if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then UpdateStartExpires(CurSchedule);
//AGP remove this code for CQ 11772
(*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 (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then
UpdateStartExpires(CurSchedule);
if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
end;
if not FInptDlg then
begin
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))
then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity,
LackQtyInfo);
if LackQtyInfo then begin
@ -4610,7 +4724,7 @@ begin
txtQuantity.Text := '0';
end
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) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0)) then
UpdateRefills(CurDispDrug, CurSupply);
@ -4632,6 +4746,7 @@ begin
Changing := SaveChanging;
if FUpdated then ControlChange(Self);
FScheduleChanged := false;
//FQOInitial := False;
end;
procedure TfrmODMeds.cmdAcceptClick(Sender: TObject);
@ -4643,6 +4758,7 @@ begin
cboScheduleClick(Self);
Exit;
end;
if timCheckChanges.Enabled = True then sleep(1500);
//AGP Change for 26.45 PSI-04-069
if self.tabDose.TabIndex = 1 then
begin
@ -4689,24 +4805,28 @@ procedure TfrmODMeds.chkDoseNowClick(Sender: TObject);
const
T = '"';
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 "';
T3 = #13'The second order''s administrative schedule is "';
T2 = #13#13'The "Give additional dose now" order has an administration schedule of "';
T3 = #13'The "Ongoing" order has an administration schedule of "';
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"';
T2A = ' in addition to the one you are placing for the same medication "';
var
medNm: string;
theSch: string;
ordPriority: string;
begin
inherited;
if (chkDoseNow.Checked) and (tabDose.TabIndex <> TI_COMPLEX) then
begin
medNm := txtMed.Text;
theSch := cboSchedule.Text;
ordPriority := cboPriority.SelText;
if length(theSch)>0 then
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 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
chkDoseNow.Checked := False;
Exit;
@ -4831,7 +4951,7 @@ begin
begin
lblAdminTime.Caption := '';
PrnPos := Pos('PRN',cboSchedule.Text);
if (PrnPos < 1) then
if (PrnPos < 1) and (FQOInitial = false) then
UpdateStartExpires(cboSchedule.Text + ' PRN');
end
else
@ -4839,12 +4959,14 @@ begin
if Length(Trim(cboSchedule.Text))>0 then
begin
tempSch := ';'+Trim(cboSchedule.Text);
UpdateStartExpires(tempSch);
if FQOInitial = false then UpdateStartExpires(tempSch);
end;
//lblAdminTime.Caption := FAdminTimeLbl;
if txtQuantity.visible then
cboScheduleClick(Self);
end;
if FQOInitial = false then updateRelated(False);
//updateRelated(False);
ControlChange(Self);
end;
@ -4964,14 +5086,12 @@ end;
procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char);
begin
(* if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then
begin
ShowEditor(grdDoses.Col, grdDoses.Row, #0);
Key := #0; //Don't let the base class turn it into a forward tab!
end *)
//else
if (Key = #13) and (ActiveControl = txtMed) then
Key := #0; //Don't let the base class turn it into a forward tab!
Key := #0 //Don't let the base class turn it into a forward tab!
else if (Key = #13) and (self.tabDose.TabIndex = TI_Complex) then
Key := #0
else
inherited;
end;
procedure TfrmODMeds.FormKeyDown(Sender: TObject; var Key: Word;
@ -4992,6 +5112,7 @@ begin
inherited;
DisableDefaultButton(self);
DisableCancelButton(self);
QuantityMessageCheck(self.grdDoses.Row);
end;
procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);
@ -5040,6 +5161,19 @@ begin
pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8;
tempAdmin := lblAdminSchGetText;
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;
procedure TfrmODMeds.memPIKeyDown(Sender: TObject; var Key: Word;
@ -5133,9 +5267,16 @@ var
begin
result := 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;
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
result := True;
end;
@ -5270,6 +5411,15 @@ begin
if Trim(cboSchedule.Text) = '' then
cboSchedule.ItemIndex := -1;
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;
procedure TfrmODMeds.ValidateInpatientSchedule(ScheduleCombo: TORComboBox);
@ -5284,7 +5434,7 @@ begin
if (Length(ScheduleCombo.Text) > 0) then
ScheduleCombo.Text := TrimLeft(UpperCase(ScheduleCombo.Text));
{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
tmpIndex := GetSchedListIndex(ScheduleCombo,ScheduleCombo.Text);
if tmpIndex > -1 then
@ -5297,10 +5447,12 @@ begin
'If you would like to create a Day-of-Week schedule please'+
' select ''OTHER'' from the list.',
'Incorrect Schedule.');
ScheduleCombo.ItemIndex := -1;
ScheduleCombo.Text := '';
FShowPnlXScheduleOk := True; //Added for CQ: 7370
if ScheduleCombo.CanFocus then
ScheduleCombo.SetFocus;
ScheduleCombo.SelStart := Length(ScheduleCombo.Text);
//ScheduleCombo.SelStart := Length(ScheduleCombo.Text);
end;
end;
@ -5370,6 +5522,14 @@ begin
ValidateInpatientSchedule(cboXSchedule);
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);
var
x: string;
@ -5395,6 +5555,7 @@ begin
inherited;
DisableDefaultButton(self);
DisableCancelButton(self);
QuantityMessageCheck(self.grdDoses.Row);
end;
procedure TfrmODMeds.cboXSequenceExit(Sender: TObject);
@ -5426,6 +5587,14 @@ begin
//UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
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);
begin
inherited;
@ -5436,6 +5605,7 @@ procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboDosage.Text = '') then cboDosage.ItemIndex := -1;
//Fix for CQ: 7545
if cboDosage.ItemIndex > -1 then
cboDosageClick(Sender)
@ -5443,10 +5613,19 @@ begin
UpdateRelated;
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;
Shift: TShiftState);
begin
inherited;
if (Key = VK_BACK) and (cboXDosage.Text = '') then cboXDosage.itemindex := -1;
//Fix for CQ: 7545
if cboXDosage.ItemIndex > -1 then
cboXDosageClick(Sender)
@ -5505,6 +5684,7 @@ begin
inherited;
//agp Change CQ 10719
self.chkXPRN.OnClick(self.chkXPRN);
QuantityMessageCheck(self.grdDoses.Row);
end;

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

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

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

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

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

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

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

@ -5,7 +5,7 @@ interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls,
ComCtrls, uConst, ORDtTm, VA508AccessibilityManager;
ComCtrls, uConst, ORDtTm, VA508AccessibilityManager, VA508AccessibilityRouter;
type
TfrmODRad = class(TfrmODBase)
@ -48,6 +48,9 @@ type
lblReason: TLabel;
txtReason: TCaptionEdit;
pnlRightBase: TORAutoPanel;
Submitlbl508: TVA508StaticText;
VA508ComponentAccessibility1: TVA508ComponentAccessibility;
VA508ComponentAccessibility2: TVA508ComponentAccessibility;
procedure cboProcedureNeedData(Sender: TObject;
const StartFrom: string; Direction, InsertAt: Integer);
procedure cboAvailModMouseClick(Sender: TObject);
@ -70,6 +73,11 @@ type
procedure chkIsolationExit(Sender: TObject);
procedure calPreOpExit(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
FLastRadID: string;
FEditCopy: boolean;
@ -81,6 +89,7 @@ type
function NoPregnantSelection : Boolean;
procedure ImageTypeChange;
procedure FormFirstOpened(Sender: TObject);
procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
protected
procedure InitDialog; override;
procedure Validate(var AnErrMsg: string); override;
@ -220,6 +229,7 @@ procedure TfrmODRad.InitDialog;
var
i: integer;
tmplst: TStringList;
cboSubmitText: String;
begin
if not FEditCopy then
begin
@ -265,6 +275,10 @@ begin
cboSubmit.ItemIndex := -1;
lblSubmit.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;
end
else if (lblAskSubmit.Caption = 'YES') then
@ -282,6 +296,10 @@ begin
cboSubmit.ItemIndex := -1 ;
lblSubmit.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;
end
else
@ -289,6 +307,10 @@ begin
cboSubmit.ItemIndex := 0;
lblSubmit.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;
end;
end
@ -300,6 +322,10 @@ begin
cboSubmit.ItemIndex := -1 ;
lblSubmit.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;
end;
chkIsolation.Checked := PatientOnIsolationProcedures(Patient.DFN) ;
@ -310,7 +336,6 @@ begin
StatusText('Initializing Long List');
cboProcedure.InitLongList('') ;
StatusText('');
end;
procedure TfrmODRad.ControlChange(Sender: TObject);
@ -350,6 +375,14 @@ begin
memOrder.Text := Responses.OrderText;
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);
var
i, j: integer;
@ -638,6 +671,8 @@ begin
PreserveControl(memHistory); {WPB-1298-30758}
if (Patient.Sex <> 'F') then
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;
radPregnantNo.Enabled := False;
radPregnantUnknown.Enabled := False;
@ -694,7 +729,10 @@ end;
procedure TfrmODRad.SetDefaultPregant;
begin
if (Patient.Sex = 'F') and ((Patient.Age > 55) or (Patient.Age < 12)) then
begin
radPregnantNo.Checked := True;
grpPregnant.TabStop := False;
end;
end;
procedure TfrmODRad.cmdAcceptClick(Sender: TObject);
@ -719,6 +757,18 @@ begin
inherited;
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);
var
i: integer;
@ -738,6 +788,8 @@ begin
with lstSelectMod do
for i := 0 to Items.Count - 1 do
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;
@ -779,6 +831,24 @@ begin
result := not ((radPregnant.Checked) or (radPregnantNo.Checked) or (radPregnantUnknown.Checked));
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);
begin
inherited;

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

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

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

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

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

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

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

@ -117,15 +117,19 @@ begin
StatusText('Releasing Orders to Service...');
SendReleaseOrders(OrdersLst);
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
begin
if Pos('E', Piece(OrdersLst[i], U, 2)) > 0 then
begin
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 +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.',
TC_SAVERR, MB_OK)
TX_SAVERR_PHARM_ORD_NUM, 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
InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,
TC_SAVERR, MB_OK);

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

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

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

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

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

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

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

@ -108,9 +108,11 @@ procedure TfrmOMSet.DoNextItem;
var
SetItem: TSetItem;
theOwner: TComponent;
ok: boolean;
procedure SkipToNext;
begin
if FClosing then Exit;
lstSet.Checked[lstSet.ItemIndex] := True;
DoNextItem;
end;
@ -142,11 +144,14 @@ begin
SetItem := TSetItem(Items.Objects[ItemIndex]);
case SetItem.DialogType of
'A': if not ActivateAction(IntToStr(SetItem.DialogIEN), 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;
'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then
begin
if Not FClosing then
@ -156,8 +161,12 @@ begin
else SkipToNext;
end;
end;
'M': if ActivateOrderMenu( IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex)
then Inc(FActiveMenus)
'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
@ -165,15 +174,20 @@ begin
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
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;
end;
else begin
InfoBox('Unsupported dialog type: ' + SetItem.DialogType, 'Error', MB_OK);
SkipToNext;
@ -185,12 +199,21 @@ end;
procedure TfrmOMSet.UMDelayEvent(var Message: TMessage);
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
// (prevents completion of an order set from calling DoNextItem)
if Message.WParam = lstSet.ItemIndex then
if lstSet.ItemIndex < lstSet.Items.Count - 1 then DoNextItem else Close;
if CloseRequested then
Close;
end;
procedure TfrmOMSet.UMDestroy(var Message: TMessage);
@ -251,6 +274,7 @@ begin
CanClose := True
else if lstSet.ItemIndex < (lstSet.Items.Count - 1)
then CanClose := InfoBox(TX_STOP, TC_STOP, MB_YESNO) = IDYES;
FClosing := CanClose;
end;
procedure TfrmOMSet.FormClose(Sender: TObject; var Action: TCloseAction);
@ -280,7 +304,10 @@ end;
procedure TfrmOMSet.cmdInteruptClick(Sender: TObject);
begin
if DoingNextItem then
CloseRequested := true //Fix for CQ: 8297
begin
CloseRequested := true; //Fix for CQ: 8297
FClosing := true;
end
else
Close;
end;

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

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

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

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

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

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

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

@ -162,6 +162,7 @@ type
procedure hdrOrdersSectionClick(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure sptHorzMoved(Sender: TObject);
procedure sptVertMoved(Sender: TObject);
private
{ Private declarations }
OrderListClickProcessing : Boolean;
@ -224,7 +225,7 @@ type
function getTotalSectionsWidth : integer; //CQ6170
function AllowContextChange(var WhyNot: string): Boolean; override;
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 ChangesUpdate(APtEvtID: string);
procedure GroupChangesUpdate(GrpName: string);
@ -1175,7 +1176,9 @@ begin
if AnOrderView.EventDelay.PtEventIFN > 0 then
FCompress := False;
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
begin
APtEvtID := IntToStr(FCurrentView.EventDelay.PtEventIFN);
@ -1397,7 +1400,9 @@ begin
4:
begin
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;
5: result := VerNurse;
6: result := VerClerk;
@ -2349,8 +2354,10 @@ var
SelectedList: TList;
ALocation: Integer;
AName: string;
Delayed: boolean;
begin
inherited;
Delayed := False;
if NoneSelected(TX_NOSEL_SIGN) then Exit;
if not AuthorizedUser then Exit;
if (User.OrderRole <> 2) and (User.OrderRole <> 3) then
@ -2374,8 +2381,11 @@ begin
end;
if not LockedForOrdering then Exit;
if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
Exit;
//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
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;
try
@ -2412,6 +2422,16 @@ begin
finally
SelectedList.Free;
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;
@ -3242,7 +3262,7 @@ begin
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
Result := False;
if IsCompletedPtEvt(APtEvtID) then
@ -3252,6 +3272,11 @@ begin
else
InfoBox('The event "Delayed ' + APtEvtName + '" ' + TX_CMPTEVT, 'Warning', MB_OK or MB_ICONWARNING);
GroupChangesUpdate('Delayed ' + APtEvtName);
if signing = true then
begin
Result := True;
exit;
end;
InitOrderSheetsForEvtDelay;
lstSheets.ItemIndex := 0;
lstSheetsClick(self);
@ -3337,6 +3362,7 @@ begin
for i := 0 to hdrOrders.Sections.Count - 1 do
hdrOrders.Sections[i].Width := origWidths[i];
lstOrders.Invalidate;
RefreshOrderList(false);
end;
end;
//end CQ6170
@ -3473,6 +3499,14 @@ begin
mnuOptimizeFieldsClick(self);
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
SpecifyFormIsNotADialog(TfrmOrders);

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

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

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

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

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

@ -92,15 +92,18 @@ begin
uCore.TempEncounterLoc := 0;
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
begin
if Pos('E', Piece(SignList[i], U, 2)) > 0 then
begin
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 +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.',
TC_SAVERR, MB_OK)
TX_SAVERR_PHARM_ORD_NUM, 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
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
TC_SAVERR, MB_OK);

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

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

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

@ -127,15 +127,18 @@ begin
//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
begin
if Pos('E', Piece(SignList[i], U, 2)) > 0 then
begin
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 +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.',
TC_SAVERR, MB_OK)
TX_SAVERR_PHARM_ORD_NUM, 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
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
TC_SAVERR, MB_OK);

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

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

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

@ -261,6 +261,8 @@ begin
inherited;
FixHeaderControlDelphi2006Bug(hdrOrders);
OKPressed := False;
hdrOrders.Sections[0].Width := Round(self.width * 0.75);
hdrOrders.Sections[1].Width := Round(self.width * 0.25);
ResizeFormToFont(Self);
SetFormPosition(Self);
end;
@ -409,12 +411,28 @@ function TfrmRenewOrders.MeasureColumnHeight(TheOrderText: string; Index,
Column: integer): integer;
var
ARect: TRect;
cnt: integer;
x: string;
begin
cnt := 0;
ARect.Left := 0;
ARect.Top := 0;
ARect.Bottom := 0;
ARect.Right := hdrOrders.Sections[Column].Width -6;
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;
function TfrmRenewOrders.AcceptOrderCheckOnRenew(const AnOrderID: string;
@ -422,12 +440,18 @@ function TfrmRenewOrders.AcceptOrderCheckOnRenew(const AnOrderID: string;
var
OIInfo,FillerID: string;
AnOIList: TStringList;
subI: integer;
begin
AnOIList := TStringList.Create;
OIInfo := DataForOrderCheck(AnOrderID);
FillerID := Piece(OIInfo,'^',2);
AnOIList.Add(OIInfo);
OrderChecksOnAccept(OCList, FillerID, '', AnOIList, AnOrderID);
subI := 1;
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);
end;

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

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

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

@ -6,7 +6,7 @@ interface
uses
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,
Menus, ORClasses, fBase508Form, fPrintLocation, VA508AccessibilityManager;
@ -210,11 +210,12 @@ var
cProvDUZ: Int64;
OrderText, ASvc: string;
PrintLoc: Integer;
AList, ClinicList, DCList, OrderPrintList, WardList: TStringList;
AList, ClinicList, OrderPrintList, WardList: TStringList;
EncLocName, EncLocText: string;
EncLocIEN: integer;
EncDT: TFMDateTime;
EncVC: Char;
//ChangeItem: TChangeItem;
function FindOrderText(const AnID: string): string;
var
@ -427,7 +428,6 @@ begin
begin
if (Patient.Inpatient = True) and (Encounter.Location <> Patient.Location) then
begin
DCList := TStringList.Create;
EncLocName := Encounter.LocationName;
EncLocIEN := Encounter.Location;
EncLocText := Encounter.LocationText;
@ -439,21 +439,26 @@ begin
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 = '' then continue;
if TOrder(SelectedList.Items[i]).EventPtr <> '' then continue;
if Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0 then
if (Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0) or
(TOrder(SelectedList.Items[i]).IsOrderPendDC = true) then
begin
DCList.Add(TOrder(SelectedList.Items[i]).ID);
WardList.Add(TOrder(SelectedList.Items[i]).ID);
Continue;
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);
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;
end else DoNotPrint := True; if (DCList <> nil) and (DCList.Count > 0) then begin for i := 0 to DCList.Count - 1 do
WardList.Add(DCList.Strings[i]);
if (WardIEN = 0) and (WardName = '') then
CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc);
end; if DCList <> nil then DCList.Free; 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;
end
else if (clinicList.count = 0) and (wardList.Count = 0) then DoNotPrint := True;
if (WardIEN = 0) and (WardName = '') then CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc);
end; end;
uCore.TempEncounterLoc := 0;
uCore.TempEncounterLocName := '';
//hds7591 Clinic/Ward movement Patient Admission IMO
@ -462,15 +467,19 @@ begin
SendOrders(SignList, frmSignOrders.ESCode);
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
begin
if Pos('E', Piece(SignList[i], U, 2)) > 0 then
begin
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 +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.',
TC_SAVERR, MB_OK)
TX_SAVERR_PHARM_ORD_NUM, 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
InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
TC_SAVERR, MB_OK);

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

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

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

@ -11,7 +11,7 @@ type
TfrmOrdersTS = class(TfrmAutoSz)
pnlMiddle: TPanel;
pnlTop: TPanel;
lblPtInfo: TLabel;
lblPtInfo: TVA508StaticText;
grpChoice: TGroupBox;
radReleaseNow: TRadioButton;
radDelayed: TRadioButton;
@ -19,9 +19,9 @@ type
Image1: TImage;
cmdOK: TButton;
cmdCancel: TButton;
Label1: TLabel;
Label2: TLabel;
Panel1: TPanel;
lblUseAdmit: TVA508StaticText;
lblUseTransfer: TVA508StaticText;
pnlBottom: TPanel;
fraEvntDelayList: TfraEvntDelayList;
procedure cmdOKClick(Sender: TObject);
procedure cmdCancelClick(Sender: TObject);
@ -170,6 +170,8 @@ begin
end;
procedure TfrmOrdersTS.cmdOKClick(Sender: TObject);
var
tempStr: String;
begin
inherited;
if grpChoice.Tag = 0 then
@ -182,6 +184,15 @@ begin
InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
Exit;
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
begin
fraEvntDelayList.CheckMatch;

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