Index: cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.dfm (revision 829) @@ -1,3 +1,3 @@ -object frmConsMedRslt: TfrmConsMedRslt +inherited frmConsMedRslt: TfrmConsMedRslt Left = 468 Top = 172 @@ -6,16 +6,10 @@ ClientHeight = 242 ClientWidth = 505 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - OldCreateOrder = True Position = poScreenCenter - OnDestroy = FormDestroy + ExplicitWidth = 320 + ExplicitHeight = 240 PixelsPerInch = 96 TextHeight = 13 - object pnlBase: TORAutoPanel + object pnlBase: TORAutoPanel [0] Left = 0 Top = 0 @@ -178,5 +172,36 @@ TabOrder = 3 OnNeedData = NewPersonNeedData - end + CharsNeedMatch = 1 + end + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBase' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = lstMedResults' + 'Status = stsDefault') + ( + 'Component = cmdDetails' + 'Status = stsDefault') + ( + 'Component = ckAlert' + 'Status = stsDefault') + ( + 'Component = calDateofAction' + 'Status = stsDefault') + ( + 'Component = cboPerson' + 'Status = stsDefault') + ( + 'Component = frmConsMedRslt' + 'Status = stsDefault')) end end Index: cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.pas (revision 829) @@ -4,5 +4,6 @@ uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, - Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox; + Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox, + VA508AccessibilityManager; type @@ -82,10 +83,10 @@ if MedResult.Action = 'ATTACH' then begin - lstMedResults.Items.Assign(GetAssignableMedResults(ConsultIEN)); + FastAssign(GetAssignableMedResults(ConsultIEN), lstMedResults.Items); ckAlert.Visible := True; end else if MedResult.Action = 'REMOVE' then begin - lstMedResults.Items.Assign(GetRemovableMedResults(ConsultIEN)); + FastAssign(GetRemovableMedResults(ConsultIEN), lstMedResults.Items); ckAlert.Visible := False; end; @@ -134,8 +135,16 @@ var x: string; + //MsgString, HasImages: string; begin inherited; if lstMedResults.ItemIndex = -1 then exit; x := Piece(Piece(Piece(lstMedResults.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstMedResults.ItemID, ';', 1); + // --------------------------------------------------------------- + // Don't do this until MED API is changed for new/unassigned results, or false '0' will be broadcast +(* MsgString := 'MED^' + x; + HasImages := BOOLCHAR[StrToIntDef(Piece(x, U, 5), 0) > 0]; + SetPiece(HasImages, U, 10, HasImages); + NotifyOtherApps(NAE_REPORT, MsgString);*) + // --------------------------------------------------------------- NotifyOtherApps(NAE_REPORT, 'MED^' + x); if(not assigned(FShowDetails)) then Index: cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.dfm (revision 829) @@ -1,22 +1,12 @@ -object frm513Print: Tfrm513Print +inherited frm513Print: Tfrm513Print Left = 116 Top = 375 - AutoScroll = False Caption = 'Print SF 513' - ClientHeight = 308 - ClientWidth = 427 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - OldCreateOrder = True + ClientHeight = 306 Position = poScreenCenter - OnCreate = FormCreate - OnDestroy = FormDestroy + ExplicitHeight = 340 PixelsPerInch = 96 TextHeight = 13 - object lblPrintTo: TLabel + object lblPrintTo: TLabel [0] Left = 7 Top = 265 @@ -24,5 +14,5 @@ Height = 13 end - object lblConsultTitle: TMemo + object lblConsultTitle: TMemo [1] Left = 10 Top = 8 @@ -36,5 +26,5 @@ TabOrder = 0 end - object grpChooseCopy: TGroupBox + object grpChooseCopy: TGroupBox [2] Left = 321 Top = 4 @@ -64,5 +54,5 @@ end end - object grpDevice: TGroupBox + object grpDevice: TGroupBox [3] Left = 8 Top = 69 @@ -131,7 +121,8 @@ OnChange = cboDeviceChange OnNeedData = cboDeviceNeedData + CharsNeedMatch = 1 end end - object cmdOK: TButton + object cmdOK: TButton [4] Left = 267 Top = 272 @@ -143,5 +134,5 @@ OnClick = cmdOKClick end - object cmdCancel: TButton + object cmdCancel: TButton [5] Left = 347 Top = 272 @@ -153,5 +144,5 @@ OnClick = cmdCancelClick end - object chkDefault: TCheckBox + object chkDefault: TCheckBox [6] Left = 7 Top = 288 @@ -161,4 +152,43 @@ TabOrder = 3 end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = lblConsultTitle' + 'Status = stsDefault') + ( + 'Component = grpChooseCopy' + 'Status = stsDefault') + ( + 'Component = radChartCopy' + 'Status = stsDefault') + ( + 'Component = radWorkCopy' + 'Status = stsDefault') + ( + 'Component = grpDevice' + 'Status = stsDefault') + ( + 'Component = txtRightMargin' + 'Status = stsDefault') + ( + 'Component = txtPageLength' + 'Status = stsDefault') + ( + 'Component = cboDevice' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = chkDefault' + 'Status = stsDefault') + ( + 'Component = frm513Print' + 'Status = stsDefault')) + end object dlgWinPrinter: TPrintDialog Left = 268 Index: cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.pas (revision 829) @@ -5,5 +5,6 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls; + fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls, + VA508AccessibilityManager, uReports; type @@ -26,5 +27,4 @@ procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); - procedure FormCreate(Sender: TObject); procedure cboDeviceChange(Sender: TObject); procedure radChartCopyClick(Sender: TObject); @@ -32,5 +32,5 @@ procedure cmdOKClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); - procedure FormDestroy(Sender: TObject); + private { Private declarations } @@ -98,16 +98,4 @@ end; -procedure Tfrm513Print.FormCreate(Sender: TObject); -begin - inherited; - FReportText := TRichEdit.Create(Self); - with FReportText do - begin - Parent := Self; - Visible := False; - Width := 600; - end; -end; - procedure Tfrm513Print.DisplaySelectDevice; begin @@ -157,4 +145,5 @@ begin inherited; + FReportText := CreateReportTextComponent(Self); RemoteSiteID := ''; RemoteQuery := ''; @@ -169,5 +158,5 @@ if dlgWinPrinter.Execute then with FReportText do begin - FReportText.Lines.Assign(GetFormattedSF513(FConsult, ChartCopy)); + QuickCopy(GetFormattedSF513(FConsult, ChartCopy), FReportText); PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg); if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); @@ -183,4 +172,5 @@ if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1)); User.CurrentPrinter := cboDevice.ItemID; + FReportText.Free; Close; end; @@ -192,9 +182,3 @@ end; -procedure Tfrm513Print.FormDestroy(Sender: TObject); -begin - FReportText.Free; - inherited; -end; - end. Index: cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm (revision 829) @@ -1,22 +1,16 @@ -object frmConsultAction: TfrmConsultAction +inherited frmConsultAction: TfrmConsultAction Left = 277 Top = 217 - Width = 600 - Height = 406 BorderIcons = [] Caption = 'frmConsultAction' - Color = clBtnFace + ClientHeight = 379 + ClientWidth = 592 Constraints.MinHeight = 406 Constraints.MinWidth = 600 - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] OldCreateOrder = True Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 - object pnlBase: TPanel + object pnlBase: TPanel [0] Left = 0 Top = 0 @@ -360,3 +354,69 @@ end end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBase' + 'Status = stsDefault') + ( + 'Component = pnlForward' + 'Status = stsDefault') + ( + 'Component = Label1' + 'Status = stsDefault') + ( + 'Component = cboAttentionOf' + 'Status = stsDefault') + ( + 'Component = cboUrgency' + 'Status = stsDefault') + ( + 'Component = treService' + 'Status = stsDefault') + ( + 'Component = cboService' + 'Status = stsDefault') + ( + 'Component = pnlOther' + 'Status = stsDefault') + ( + 'Component = pnlSigFind' + 'Status = stsDefault') + ( + 'Component = grpSigFindings' + 'Status = stsDefault') + ( + 'Component = pnlComments' + 'Status = stsDefault') + ( + 'Component = memComments' + 'Status = stsDefault') + ( + 'Component = pnlAlert' + 'Status = stsDefault') + ( + 'Component = lblAutoAlerts' + 'Status = stsDefault') + ( + 'Component = ckAlert' + 'Status = stsDefault') + ( + 'Component = pnlAllActions' + 'Status = stsDefault') + ( + 'Component = calDateofAction' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = cboPerson' + 'Status = stsDefault') + ( + 'Component = frmConsultAction' + 'Status = stsDefault')) + end end Index: cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN, - StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm; + StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm, fBase508Form, + VA508AccessibilityManager; type - TfrmConsultAction = class(TForm) + TfrmConsultAction = class(TfrmBase508Form) lblActionBy: TOROffsetLabel; calDateofAction: TORDateBox; @@ -160,6 +161,6 @@ begin OrdItmIEN := GetOrderableIEN(IntToStr(ConsultRec.ORFileNumber)); - SvcList.Assign(GetProcedureServices(OrdItmIEN)); - //SvcList.Assign(GetProcedureServices(ProcIEN)); RPC expects pointer to 101.43, NOT 123.3 (RV) + FastAssign(GetProcedureServices(OrdItmIEN), SvcList); + //FastAssign(GetProcedureServices(ProcIEN), SvcList); RPC expects pointer to 101.43, NOT 123.3 (RV) i := SvcList.IndexOf(IntToStr(ConsultRec.ToService) + U + Trim(ExternalName(ConsultRec.ToService, 123.5))); if i > -1 then SvcList.Delete(i); @@ -167,5 +168,5 @@ end else - SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN)); {RV} + FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN), SvcList); {RV} if (IsProcedure and (SvcList.Count <= 0)) then begin @@ -204,7 +205,7 @@ FToService := cboService.ItemIEN; cboAttentionOf.InitLongList('') ; - with cboUrgency do - begin - Items.Assign(SubsetofUrgencies(ConsultRec.IEN)) ; + with cboUrgency do + begin + FastAssign(SubsetofUrgencies(ConsultRec.IEN), cboUrgency.Items) ; MixedCaseList(Items) ; SelectByIEN(ConsultRec.Urgency); @@ -562,5 +563,5 @@ end; -procedure TfrmConsultAction.ShowAutoAlertText; +(*procedure TfrmConsultAction.ShowAutoAlertText; **** SEE BELOW FOR REPLACEMENT - v27.9 Phelps/Vertigan const TX_ALERT1 = 'An alert will automatically be sent to '; @@ -588,5 +589,42 @@ end; lblAutoAlerts.Caption := x; -end; +end;*) + +procedure TfrmConsultAction.ShowAutoAlertText; +const + TX_ALERT1 = 'An alert will automatically be sent to '; + TX_ALERT_PROVIDER = 'the ordering provider'; + TX_ALERT_SVC_USERS = 'notification recipients for this service.'; + TX_ALERT_NOBODY = 'No automatic alerts will be sent.'; // this should be rare to never +var + x: string; +begin + case FUserLevel of + UL_NONE, UL_REVIEW: + begin + if FUserIsRequester then + x := TX_ALERT1 + TX_ALERT_SVC_USERS + else + x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS; + end; + UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN: + begin + if FUserIsRequester then + //x := TX_ALERT_NOBODY Replace with following line + x := TX_ALERT1 + TX_ALERT_SVC_USERS + else + x := TX_ALERT1 + TX_ALERT_PROVIDER + '.'; + end; + UL_UNRESTRICTED: + begin + if FUserIsRequester then + x := TX_ALERT1 + TX_ALERT_SVC_USERS + else + x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS; + end; + end; + lblAutoAlerts.Caption := x; +end; + initialization Index: cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.dfm (revision 829) @@ -1,3 +1,3 @@ -object frmConsultAlertsTo: TfrmConsultAlertsTo +inherited frmConsultAlertsTo: TfrmConsultAlertsTo Left = 297 Top = 206 @@ -5,23 +5,18 @@ Caption = 'Send Alert' ClientHeight = 262 - ClientWidth = 358 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + ClientWidth = 371 OldCreateOrder = True Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 - object pnlBase: TORAutoPanel + object pnlBase: TORAutoPanel [0] Left = 0 Top = 0 - Width = 358 + Width = 371 Height = 262 Align = alClient BevelOuter = bvNone TabOrder = 0 + ExplicitWidth = 358 object SrcLabel: TLabel Left = 12 @@ -32,5 +27,5 @@ end object DstLabel: TLabel - Left = 196 + Left = 217 Top = 14 Width = 132 @@ -45,5 +40,5 @@ Caption = 'OK' ModalResult = 1 - TabOrder = 2 + TabOrder = 4 OnClick = cmdOKClick end @@ -56,5 +51,5 @@ Caption = 'Cancel' ModalResult = 2 - TabOrder = 3 + TabOrder = 5 OnClick = cmdCancelClick end @@ -83,7 +78,8 @@ OnMouseClick = cboSrcListMouseClick OnNeedData = cboSrcListNeedData + CharsNeedMatch = 1 end object DstList: TORListBox - Left = 196 + Left = 217 Top = 30 Width = 144 @@ -93,5 +89,5 @@ ParentShowHint = False ShowHint = True - TabOrder = 1 + TabOrder = 2 OnClick = DstListClick Caption = 'Currently selected recipients' @@ -100,4 +96,49 @@ Pieces = '2' end + object btnAdd: TButton + Left = 160 + Top = 109 + Width = 51 + Height = 25 + Caption = 'Add' + TabOrder = 1 + OnClick = cboSrcListMouseClick + end + object btnRemove: TButton + Left = 160 + Top = 140 + Width = 51 + Height = 25 + Caption = 'Remove' + TabOrder = 3 + OnClick = DstListClick + end + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBase' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = cboSrcList' + 'Status = stsDefault') + ( + 'Component = DstList' + 'Status = stsDefault') + ( + 'Component = btnAdd' + 'Status = stsDefault') + ( + 'Component = btnRemove' + 'Status = stsDefault') + ( + 'Component = frmConsultAlertsTo' + 'Status = stsDefault')) end end Index: cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.pas (revision 829) @@ -4,8 +4,8 @@ uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, - Buttons, ORCtrls, ORfn, ExtCtrls; + Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager; type - TfrmConsultAlertsTo = class(TForm) + TfrmConsultAlertsTo = class(TfrmBase508Form) cmdOK: TButton; cmdCancel: TButton; @@ -15,4 +15,6 @@ DstLabel: TLabel; pnlBase: TORAutoPanel; + btnAdd: TButton; + btnRemove: TButton; procedure cboSrcListNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Index: cprs/trunk/CPRS-Chart/Consults/fConsultBD.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultBD.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultBD.dfm (revision 829) @@ -1,20 +1,16 @@ -object frmConsultsByDate: TfrmConsultsByDate +inherited frmConsultsByDate: TfrmConsultsByDate Left = 372 Top = 217 - Width = 259 - Height = 178 BorderIcons = [] Caption = 'List Consults by Date Range' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + ClientHeight = 151 + ClientWidth = 251 OldCreateOrder = True Position = poScreenCenter + ExplicitWidth = 259 + ExplicitHeight = 178 PixelsPerInch = 96 TextHeight = 13 - object pnlBase: TORAutoPanel + object pnlBase: TORAutoPanel [0] Left = 0 Top = 0 @@ -90,3 +86,27 @@ end end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBase' + 'Status = stsDefault') + ( + 'Component = calBeginDate' + 'Status = stsDefault') + ( + 'Component = calEndDate' + 'Status = stsDefault') + ( + 'Component = radSort' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = frmConsultsByDate' + 'Status = stsDefault')) + end end Index: cprs/trunk/CPRS-Chart/Consults/fConsultBD.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultBD.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultBD.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN, - StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults; + StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults, fBase508Form, + VA508AccessibilityManager; type - TfrmConsultsByDate = class(TForm) + TfrmConsultsByDate = class(TfrmBase508Form) pnlBase: TORAutoPanel; lblBeginDate: TLabel; Index: cprs/trunk/CPRS-Chart/Consults/fConsultBS.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultBS.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultBS.dfm (revision 829) @@ -1,20 +1,14 @@ -object frmConsultsByService: TfrmConsultsByService +inherited frmConsultsByService: TfrmConsultsByService Left = 339 Top = 175 - Width = 328 - Height = 412 BorderIcons = [] Caption = 'List Consults by Service' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + ClientHeight = 385 + ClientWidth = 320 OldCreateOrder = True Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 - object pnlBase: TORAutoPanel + object pnlBase: TORAutoPanel [0] Left = 0 Top = 0 @@ -90,4 +84,5 @@ ListItemsOnly = True LongList = False + LookupPiece = 0 MaxLength = 0 Pieces = '2' @@ -97,5 +92,30 @@ OnKeyPause = cboServiceSelect OnMouseClick = cboServiceSelect + CharsNeedMatch = 1 end end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBase' + 'Status = stsDefault') + ( + 'Component = radSort' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = treService' + 'Status = stsDefault') + ( + 'Component = cboService' + 'Status = stsDefault') + ( + 'Component = frmConsultsByService' + 'Status = stsDefault')) + end end Index: cprs/trunk/CPRS-Chart/Consults/fConsultBS.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultBS.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultBS.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults; + ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults, fBase508Form, + VA508AccessibilityManager; type - TfrmConsultsByService = class(TForm) + TfrmConsultsByService = class(TfrmBase508Form) pnlBase: TORAutoPanel; lblService: TLabel; @@ -71,6 +72,6 @@ ClientHeight := H; pnlBase.Height := H; FChanged := False; - //SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP)); {RV} - SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP)); {RV} + //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList); {RV} + FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList); {RV} SortByPiece(TStringList(SvcList), U, 2); {RV} for i := 0 to SvcList.Count - 1 do Index: cprs/trunk/CPRS-Chart/Consults/fConsultBSt.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultBSt.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultBSt.dfm (revision 829) @@ -1,20 +1,14 @@ -object frmConsultsByStatus: TfrmConsultsByStatus +inherited frmConsultsByStatus: TfrmConsultsByStatus Left = 286 Top = 202 - Width = 316 - Height = 232 BorderIcons = [] Caption = 'List Consults by Status' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + ClientHeight = 205 + ClientWidth = 308 OldCreateOrder = True Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 - object pnlBase: TORAutoPanel + object pnlBase: TORAutoPanel [0] Left = 0 Top = 0 @@ -78,3 +72,24 @@ end end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBase' + 'Status = stsDefault') + ( + 'Component = radSort' + 'Status = stsDefault') + ( + 'Component = lstStatus' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = frmConsultsByStatus' + 'Status = stsDefault')) + end end Index: cprs/trunk/CPRS-Chart/Consults/fConsultBSt.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultBSt.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultBSt.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults; + ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults, fBase508Form, + VA508AccessibilityManager; type - TfrmConsultsByStatus = class(TForm) + TfrmConsultsByStatus = class(TfrmBase508Form) pnlBase: TORAutoPanel; lblStatus: TLabel; @@ -62,5 +63,5 @@ FChanged := False; with radSort do {if SortConsultsAscending then ItemIndex := 0 else} ItemIndex := 1; - lstStatus.Items.Assign(SubSetOfStatus); + FastAssign(SubSetOfStatus, lstStatus.Items); CurrentStatus := CurrentContext.Status; if CurrentStatus <> '' then with lstStatus do Index: cprs/trunk/CPRS-Chart/Consults/fConsults.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsults.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsults.dfm (revision 829) @@ -1,14 +1,15 @@ inherited frmConsults: TfrmConsults - Left = 247 - Top = 174 - Width = 723 - Height = 467 + Left = 402 + Top = 80 HelpContext = 6000 Caption = 'Consults Page' + ClientHeight = 421 + ClientWidth = 715 Menu = mnuConsults OnDestroy = FormDestroy OnHide = FormHide - OnMouseMove = FormMouseMove OnShow = FormShow + ExplicitWidth = 723 + ExplicitHeight = 467 PixelsPerInch = 96 TextHeight = 13 @@ -16,4 +17,6 @@ Top = 416 Width = 715 + ExplicitTop = 416 + ExplicitWidth = 715 end inherited sptHorz: TSplitter @@ -22,4 +25,7 @@ Height = 416 OnCanResize = sptHorzCanResize + ExplicitLeft = 83 + ExplicitWidth = 2 + ExplicitHeight = 416 end inherited pnlRight: TPanel [2] @@ -27,5 +33,9 @@ Width = 630 Height = 416 + OnExit = pnlRightExit OnResize = pnlRightResize + ExplicitLeft = 85 + ExplicitWidth = 630 + ExplicitHeight = 416 object sptVert: TSplitter Left = 0 @@ -44,5 +54,4 @@ BevelOuter = bvNone TabOrder = 0 - OnExit = pnlResultsExit object lblTitle: TOROffsetLabel Left = 0 @@ -91,5 +100,4 @@ WantReturns = False WordWrap = False - OnMouseMove = FormMouseMove end end @@ -112,5 +120,4 @@ BevelOuter = bvNone TabOrder = 1 - OnExit = pnlResultsExit OnResize = pnlResultsResize object memResults: TRichEdit @@ -132,5 +139,4 @@ OnChange = memResultChange OnKeyDown = memResultsKeyDown - OnMouseMove = FormMouseMove end object pnlFields: TPanel @@ -240,5 +246,4 @@ TabOrder = 0 OnClick = cmdChangeClick - OnMouseMove = FormMouseMove end object txtSubject: TCaptionEdit @@ -254,5 +259,4 @@ TabOrder = 1 Text = 'txtSubject' - OnMouseMove = FormMouseMove Caption = 'Subject' end @@ -263,5 +267,8 @@ Width = 83 Height = 416 + OnExit = pnlLeftExit OnResize = pnlLeftResize + ExplicitWidth = 83 + ExplicitHeight = 416 object splConsults: TSplitter Left = 0 @@ -280,5 +287,4 @@ BevelOuter = bvNone TabOrder = 1 - OnExit = pnlActionExit object splDrawers: TSplitter Left = 0 @@ -294,10 +300,11 @@ Width = 83 Height = 21 + Align = alTop Caption = 'New Consult' Constraints.MinHeight = 21 - TabOrder = 2 + Default = True + TabOrder = 1 OnClick = cmdNewConsultClick - OnMouseMove = FormMouseMove - Align = alTop + OnExit = cmdNewConsultExit end object cmdNewProc: TORAlignButton @@ -306,10 +313,9 @@ Width = 83 Height = 21 + Align = alTop Caption = 'New Procedure' Constraints.MinHeight = 21 - TabOrder = 3 + TabOrder = 2 OnClick = cmdNewProcClick - OnMouseMove = FormMouseMove - Align = alTop end object cmdEditResubmit: TORAlignButton @@ -318,4 +324,5 @@ Width = 83 Height = 21 + Align = alTop Caption = 'Edit/Resubmit' Constraints.MinHeight = 21 @@ -326,9 +333,8 @@ Font.Style = [] ParentFont = False - TabOrder = 1 + TabOrder = 0 Visible = False OnClick = cmdEditResubmitClick - OnMouseMove = FormMouseMove - Align = alTop + OnExit = cmdEditResubmitExit end object lstNotes: TORListBox @@ -345,5 +351,4 @@ Visible = False OnClick = lstNotesClick - OnMouseMove = FormMouseMove ItemTipColor = clWindow LongList = False @@ -359,8 +364,10 @@ Constraints.MinWidth = 30 HideSelection = False + Images = dmodShared.imgNotes Indent = 19 PopupMenu = popNoteList ReadOnly = True - TabOrder = 0 + StateImages = dmodShared.imgImages + TabOrder = 3 OnChange = tvCsltNotesChange OnClick = tvCsltNotesClick @@ -369,5 +376,4 @@ OnDragOver = tvCsltNotesDragOver OnExpanded = tvCsltNotesExpanded - OnMouseMove = FormMouseMove OnStartDrag = tvCsltNotesStartDrag Caption = 'Consult Notes' @@ -380,4 +386,5 @@ Width = 83 Height = 21 + Align = alBottom Caption = 'Encounter' Enabled = False @@ -385,7 +392,4 @@ Visible = False OnClick = cmdPCEClick - OnExit = pnlActionExit - OnMouseMove = FormMouseMove - Align = alBottom end object pnlConsultList: TPanel @@ -436,16 +440,14 @@ Align = alClient HideSelection = False - Indent = 15 + Images = dmodShared.imgConsults + Indent = 19 PopupMenu = popNoteList ReadOnly = True TabOrder = 0 - OnAddition = tvConsultsAddition OnClick = tvConsultsClick OnCollapsed = tvConsultsCollapsed - OnDeletion = tvConsultsDeletion OnExit = tvConsultsExit OnExpanded = tvConsultsExpanded OnKeyUp = tvConsultsKeyUp - OnMouseMove = FormMouseMove Caption = 'Consults' NodePiece = 0 @@ -453,4 +455,88 @@ end end + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlRead' + 'Status = stsDefault') + ( + 'Component = memConsult' + 'Status = stsDefault') + ( + 'Component = memPCEShow' + 'Status = stsDefault') + ( + 'Component = pnlResults' + 'Status = stsDefault') + ( + 'Component = memResults' + 'Status = stsDefault') + ( + 'Component = pnlFields' + 'Status = stsDefault') + ( + 'Component = lblRefDate' + 'Status = stsDefault') + ( + 'Component = lblAuthor' + 'Status = stsDefault') + ( + 'Component = lblVisit' + 'Status = stsDefault') + ( + 'Component = lblCosigner' + 'Status = stsDefault') + ( + 'Component = lblSubject' + 'Status = stsDefault') + ( + 'Component = lblNewTitle' + 'Status = stsDefault') + ( + 'Component = cmdChange' + 'Status = stsDefault') + ( + 'Component = txtSubject' + 'Status = stsDefault') + ( + 'Component = pnlAction' + 'Status = stsDefault') + ( + 'Component = cmdNewConsult' + 'Status = stsDefault') + ( + 'Component = cmdNewProc' + 'Status = stsDefault') + ( + 'Component = cmdEditResubmit' + 'Status = stsDefault') + ( + 'Component = lstNotes' + 'Status = stsDefault') + ( + 'Component = tvCsltNotes' + 'Status = stsDefault') + ( + 'Component = cmdPCE' + 'Status = stsDefault') + ( + 'Component = pnlConsultList' + 'Status = stsDefault') + ( + 'Component = lstConsults' + 'Status = stsDefault') + ( + 'Component = tvConsults' + 'Status = stsDefault') + ( + 'Component = pnlLeft' + 'Status = stsDefault') + ( + 'Component = pnlRight' + 'Status = stsDefault') + ( + 'Component = frmConsults' + 'Status = stsDefault')) end object popNoteMemo: TPopupMenu @@ -1044,3 +1130,33 @@ Top = 303 end + object imgLblNotes: TVA508ImageListLabeler + Components = < + item + Component = tvCsltNotes + end> + Labels = <> + RemoteLabeler = dmodShared.imgLblNotes + Left = 16 + Top = 48 + end + object imgLblImages: TVA508ImageListLabeler + Components = < + item + Component = tvCsltNotes + end> + Labels = <> + RemoteLabeler = dmodShared.imgLblImages + Left = 8 + Top = 88 + end + object imgLblConsults: TVA508ImageListLabeler + Components = < + item + Component = tvConsults + end> + Labels = <> + RemoteLabeler = dmodShared.imgLblConsults + Left = 56 + Top = 96 + end end Index: cprs/trunk/CPRS-Chart/Consults/fConsults.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsults.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsults.pas (revision 829) @@ -1,4 +1,8 @@ unit fConsults; - +{Notes of Intent: + Tab Order: + The tab order has been custom coded to place the pnlRight in the Tab order + right after the tvConsults. +} interface @@ -7,5 +11,6 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORDtTm, fHSplit, stdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConsults, rOrders, uPCE, - ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList; + ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList, + VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler; type @@ -172,4 +177,7 @@ mnuViewRemoteData: TMenuItem; mnuViewPostings: TMenuItem; + imgLblNotes: TVA508ImageListLabeler; + imgLblImages: TVA508ImageListLabeler; + imgLblConsults: TVA508ImageListLabeler; procedure mnuChartTabClick(Sender: TObject); procedure lstConsultsClick(Sender: TObject); @@ -268,16 +276,15 @@ procedure popNoteMemoPreviewClick(Sender: TObject); procedure popNoteMemoInsTemplateClick(Sender: TObject); - procedure tvConsultsAddition(Sender: TObject; Node: TTreeNode); - procedure tvConsultsDeletion(Sender: TObject; Node: TTreeNode); procedure tvConsultsExit(Sender: TObject); - procedure pnlResultsExit(Sender: TObject); - procedure pnlActionExit(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormShow(Sender: TObject); - procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); procedure ViewInfo(Sender: TObject); procedure mnuViewInformationClick(Sender: TObject); + procedure pnlLeftExit(Sender: TObject); + procedure pnlRightExit(Sender: TObject); + procedure cmdEditResubmitExit(Sender: TObject); + procedure cmdNewConsultExit(Sender: TObject); private + FocusToRightPanel : Boolean; FEditingIndex: Integer; // TIU index of document being currently edited FChanged: Boolean; @@ -300,12 +307,7 @@ FNotifPending: boolean; FOldFramePnlPatientExit: TNotifyEvent; - FOldDrawerPnlTemplatesButtonExit: TNotifyEvent; - FOldDrawerPnlEncounterButtonExit: TNotifyEvent; - FOldDrawerEdtSearchExit: TNotifyEvent; - FMousing: TDateTime; + //FMousing: TDateTime; + procedure DoLeftPanelCustomShiftTab; procedure frmFramePnlPatientExit(Sender: TObject); - procedure frmDrawerPnlTemplatesButtonExit(Sender: TObject); - procedure frmDrawerPnlEncounterButtonExit(Sender: TObject); - procedure frmDrawerEdtSearchExit(Sender: TObject); procedure DoAutoSave(Suppress: integer = 1); function GetTitleText(AnIndex: Integer): string; @@ -395,5 +397,5 @@ fReminderDialog, uReminders, fConsMedRslt, fTemplateFieldEditor, dShared, rTemplates, fIconLegend, fNoteIDParents, fNoteCPFields, - uTemplates, uAccessibleTreeView, uAccessibleTreeNode, fTemplateDialog, DateUtils; + uTemplates, fTemplateDialog, DateUtils, uVA508CPRSCompatibility, VA508AccessibilityRouter; const @@ -906,5 +908,5 @@ DocInfo := MakeXMLParamTIU(IntToStr(CreatedNote.IEN), FEditNote); ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo); - memResults.Lines.Assign(TmpBoilerPlate); + QuickCopyWith508Msg(TmpBoilerPlate, memResults); TmpBoilerPlate.Free; end; @@ -1107,5 +1109,5 @@ DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote); ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo); - memResults.Lines.Assign(TmpBoilerPlate); + QuickCopyWith508Msg(TmpBoilerPlate, memResults); TmpBoilerPlate.Free; end; @@ -1221,4 +1223,13 @@ { Form events -----------------------------------------------------------------} + +procedure TfrmConsults.pnlRightExit(Sender: TObject); +begin + inherited; + if TabIsPressed then + FindNextControl(tvConsults, True, True, False).SetFocus + else if ShiftTabIsPressed then + FindNextControl(pnlLeft, True, True, False).SetFocus; +end; procedure TfrmConsults.pnlRightResize(Sender: TObject); @@ -1383,4 +1394,11 @@ end; +procedure TfrmConsults.cmdNewConsultExit(Sender: TObject); +begin + inherited; + if Not cmdEditResubmit.Visible then + DoLeftPanelCustomShiftTab; +end; + procedure TfrmConsults.cmdNewProcClick(Sender: TObject); begin @@ -2338,5 +2356,5 @@ mnuActPrintSF513.Enabled := True; mnuActConsultResults.Enabled := (lstConsults.ItemIEN > 0) and - (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN)) and + (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN) or (UserLevel = UL_UNRESTRICTED)) and ((status<>ST_DISCONTINUED) and (status<>ST_CANCELLED))) @@ -2365,5 +2383,6 @@ mnuActComplete.Enabled := mnuActConsultResults.Enabled and ((MenuAccessRec.UserLevel = UL_UPDATE) or - (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN)) + (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or + (MenuAccessRec.UserLevel = UL_UNRESTRICTED)) and ((ConsultRec.ORStatus=ST_PENDING) or @@ -2374,5 +2393,6 @@ mnuActMakeAddendum.Enabled := mnuActConsultResults.Enabled and ((MenuAccessRec.UserLevel = UL_UPDATE) or - (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN)) + (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or + (MenuAccessRec.UserLevel = UL_UNRESTRICTED)) and (ConsultRec.ORStatus=ST_COMPLETE) and @@ -2631,7 +2651,9 @@ if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4)= 'MCAR' then begin - memConsult.Lines.Assign(GetDetailedMedicineResults(lstNotes.ItemID)); + QuickCopy(GetDetailedMedicineResults(lstNotes.ItemID), memConsult); x := Piece(Piece(Piece(lstNotes.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstNotes.ItemID, ';', 1); - NotifyOtherApps(NAE_REPORT, 'MED^' + x); + x := 'MED^' + x; + SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11)); + NotifyOtherApps(NAE_REPORT, x); end else @@ -2640,5 +2662,7 @@ mnuActChange.Enabled := False; mnuActLoadBoiler.Enabled := False; - NotifyOtherApps(NAE_REPORT, 'TIU^' + lstNotes.ItemID); + x := 'TIU^' + lstNotes.ItemID; + SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11)); + NotifyOtherApps(NAE_REPORT, x); end; memConsult.SelStart := 0; @@ -2814,4 +2838,5 @@ end; +{for printing multiple notes} procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList); var @@ -2819,20 +2844,13 @@ 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(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} + for i := 0 to Items.Count - 1 do + 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); + end; end; @@ -2852,4 +2870,6 @@ memConsult.SelStart := 0; SetResultMenus; + if memConsult.CanFocus then + memConsult.SetFocus; end; @@ -2883,15 +2903,24 @@ LimitEditWidth(memResults, MAX_ENTRY_WIDTH - 1); memResults.Constraints.MinWidth := TextWidthByFont(memResults.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth; - pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width; + //CQ13181 508 Consults--Splitter bar doesn't retain size + //CQ13181 pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width; end; procedure TfrmConsults.NotifyOrder(OrderAction: Integer; AnOrder: TOrder); +var + SavedCsltID: string; begin if ViewContext = 0 then exit; // form has not yet been displayed, so nothing to update if EditingIndex <> -1 then exit; // do not rebuild list until after save + with tvConsults do if Selected <> nil then SavedCsltID := lstConsults.ItemID; case OrderAction of ORDER_NEW: UpdateList ; ORDER_SIGN: UpdateList{ sent by fReview, fOrderSign when orders signed, AnOrder=nil} end; + if SavedCsltID <> '' then with tvConsults do + begin + Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode); + tvConsultsChange(Self, Selected); + end; end; @@ -2925,8 +2954,6 @@ begin inherited; + FocusToRightPanel := False; PageID := CT_CONSULTS; - memConsult.Color := ReadOnlyColor; - memPCEShow.Color := ReadOnlyColor; - lblNewTitle.Color := ReadOnlyColor; EditingIndex := -1; FLastNoteID := ''; @@ -2940,7 +2967,4 @@ frmDrawers.Splitter := splDrawers; frmDrawers.DefTempPiece := 2; - tvCsltNotes.Images := dmodShared.imgNotes; - tvCsltNotes.StateImages := dmodShared.imgImages; - tvConsults.Images := dmodShared.imgConsults; FImageFlag := TBitmap.Create; FDocList := TStringList.Create; @@ -2952,5 +2976,4 @@ end; FCsltList := TStringList.Create; - TAccessibleTreeView.WrapControl(tvConsults); end; @@ -2968,4 +2991,6 @@ tvConsultsChange(Self, tvConsults.Selected); //lstConsultsClick(Self); + if memConsult.CanFocus then + memConsult.SetFocus; end; @@ -3255,4 +3280,10 @@ end; +procedure TfrmConsults.cmdEditResubmitExit(Sender: TObject); +begin + inherited; + DoLeftPanelCustomShiftTab; +end; + procedure TfrmConsults.mnuViewSaveAsDefaultClick(Sender: TObject); begin @@ -3291,4 +3322,17 @@ inherited; EditTemplates(Self, True); +end; + +procedure TfrmConsults.pnlLeftExit(Sender: TObject); +begin + inherited; + if (Not FocusToRightPanel) then + if ShiftTabIsPressed then + frmFrame.tabPage.SetFocus + else if TabIsPressed then + frmFrame.pnlPatient.SetFocus; + + if FocusToRightPanel then + FocusToRightPanel := False; end; @@ -3387,5 +3431,4 @@ procedure TfrmConsults.FormDestroy(Sender: TObject); begin - TAccessibleTreeView.UnwrapControl(tvConsults); FDocList.Free; FCsltList.Free; @@ -3578,5 +3621,5 @@ if (DocType = TYP_ADDENDUM) then begin - if AskCosignerForDocument(Addend, Author) and (Cosigner <= 0) then Result := True; + if AskCosignerForDocument(Addend, Author, DateTime) and (Cosigner <= 0) then Result := True; end else begin @@ -3695,4 +3738,5 @@ ErrMsg: string; begin + if fFrame.frmFrame.DLLActive = True then Exit; if (EditingIndex > -1) and FChanged then begin @@ -3711,4 +3755,12 @@ InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING); //Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg); +end; + +procedure TfrmConsults.DoLeftPanelCustomShiftTab; +begin + if ShiftTabIsPressed then begin + FocusToRightPanel := True; + FindNextControl(frmFrame.pnlPatient, False, True, False).SetFocus; + end; end; @@ -3828,5 +3880,5 @@ begin ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo); - memResults.Lines.Assign(BoilerText); + QuickCopyWith508Msg(BoilerText, memResults); FChanged := False; end; @@ -3849,5 +3901,5 @@ 1: begin ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo); - memResults.Lines.AddStrings(BoilerText); // append + QuickCopyWith508Msg(BoilerText, memResults); // append end; 2: AssignBoilerText; // replace @@ -4283,5 +4335,5 @@ CreateListItemsforConsultTree(FCsltList, tmpList, ViewContext, GroupBy, Ascending); UpdateConsultsTreeView(FCsltList, tvConsults); - lstConsults.Items.Assign(tmpList); + FastAssign(tmpList, lstConsults.Items); end; with tvConsults do @@ -4309,5 +4361,5 @@ uChanging := True; Items.BeginUpdate; - lstConsults.Items.AddStrings(DocList); + FastAddStrings(DocList, lstConsults.Items); BuildConsultsTree(Tree, DocList, '0', nil, FCurrentContext); Items.EndUpdate; @@ -4539,5 +4591,5 @@ Signers := TStringList.Create; try - Signers.Assign(GetCurrentSigners(NoteIEN)); + FastAssign(GetCurrentSigners(NoteIEN), Signers); for i := 0 to Signers.Count - 1 do if Piece(Signers[i], U, 1) = IntToStr(User.DUZ) then @@ -4594,18 +4646,4 @@ end; -procedure TfrmConsults.tvConsultsAddition(Sender: TObject; - Node: TTreeNode); -begin - inherited; - TAccessibleTreeNode.WrapControl(Node as TORTreeNode); -end; - -procedure TfrmConsults.tvConsultsDeletion(Sender: TObject; - Node: TTreeNode); -begin - inherited; - TAccessibleTreeNode.UnwrapControl(Node as TORTreeNode); -end; - procedure TfrmConsults.lstConsultsToPrint; var @@ -4630,94 +4668,10 @@ end; - -{Tab Order tricks. Need to change - tvConsult - - tvCsltNotes - cmdEditResubmit - cmdNewConsult - cmdNewProc - frmDrawers.pnlTemplateButton - frmDrawers.pnlEncounterButton - cmdPCE - - cmdChange - txtSubject - memResults - -to - tvConsult - - cmdChange - txtSubject - memResults - - tvCsltNotes - cmdEditResubmit - cmdNewConsult - cmdNewProc - frmDrawers.pnlTemplateButton - frmDrawers.pnlEncounterButton - cmdPCE -} - procedure TfrmConsults.tvConsultsExit(Sender: TObject); begin inherited; - if IncSecond(FMousing,1) < Now then - begin - if (Screen.ActiveControl = tvCsltNotes) or - (Screen.ActiveControl = cmdEditResubmit) or - (Screen.ActiveControl = cmdNewConsult) or - (Screen.ActiveControl = cmdNewProc) or - (Screen.ActiveControl = frmDrawers.pnlTemplatesButton) or - (Screen.ActiveControl = frmDrawers.pnlEncounterButton) or - (Screen.ActiveControl = cmdPCE) then - FindNextControl( cmdPCE, True, True, False).SetFocus; - end; - FMousing := 0; -end; - -procedure TfrmConsults.pnlResultsExit(Sender: TObject); -begin - inherited; - if IncSecond(FMousing,1) < Now then - begin - if (Screen.ActiveControl = frmFrame.pnlPatient) then - FindNextControl( tvConsults, True, True, False).SetFocus - else - if (Screen.ActiveControl = tvCsltNotes) or - (Screen.ActiveControl = cmdEditResubmit) or - (Screen.ActiveControl = cmdNewConsult) or - (Screen.ActiveControl = cmdNewProc) or - (Screen.ActiveControl = frmDrawers.pnlTemplatesButton) or - (Screen.ActiveControl = frmDrawers.pnlEncounterButton) or - (Screen.ActiveControl = cmdPCE) then - FindNextControl( tvCsltNotes, False, True, False).SetFocus; - end; - FMousing := 0; -end; - -procedure TfrmConsults.pnlActionExit(Sender: TObject); -begin - inherited; - if IncSecond(FMousing,1) < Now then - begin - if (Screen.ActiveControl = memConsult) or - (Screen.ActiveControl = cmdChange) or - (Screen.ActiveControl = txtSubject) or - (Screen.ActiveControl = memResults) then - begin - //frmFrame.pnlPatient.SetFocus //COMMENTED OUT FOR CQ6498 - if memResults.CanFocus then - memResults.SetFocus //ADDED THIS LINE FOR CQ6498 - else - memConsult.SetFocus; - end - else - if (Screen.ActiveControl = tvConsults) then - FindNextControl( frmFrame.pnlPatient, False, True, False).SetFocus; - end; - FMousing := 0; + FocusToRightPanel := True; + if TabIsPressed then + FindNextControl(pnlLeft, False, True, False).SetFocus; end; @@ -4725,13 +4679,6 @@ begin FOldFramePnlPatientExit(Sender); - if IncSecond(FMousing,1) < Now then - begin - if (Screen.ActiveControl = memConsult) or - (Screen.ActiveControl = cmdChange) or - (Screen.ActiveControl = txtSubject) or - (Screen.ActiveControl = memResults) then - FindNextControl( memConsult, False, True, False).SetFocus; - end; - FMousing := 0; + if ShiftTabIsPressed then + FindNextControl( pnlRight, False, True, False).SetFocus; end; @@ -4740,7 +4687,4 @@ inherited; frmFrame.pnlPatient.OnExit := FOldFramePnlPatientExit; - frmDrawers.pnlTemplatesButton.OnExit := FOldDrawerPnlTemplatesButtonExit; - frmDrawers.pnlEncounterButton.OnExit := FOldDrawerPnlEncounterButtonExit; - frmDrawers.edtSearch.OnExit := FOldDrawerEdtSearchExit; end; @@ -4752,10 +4696,4 @@ FOldFramePnlPatientExit := frmFrame.pnlPatient.OnExit; frmFrame.pnlPatient.OnExit := frmFramePnlPatientExit; - FOldDrawerPnlTemplatesButtonExit := frmDrawers.pnlTemplatesButton.OnExit; - frmDrawers.pnlTemplatesButton.OnExit := frmDrawerPnlTemplatesButtonExit; - FOldDrawerPnlEncounterButtonExit := frmDrawers.pnlEncounterButton.OnExit; - frmDrawers.pnlEncounterButton.OnExit := frmDrawerPnlEncounterButtonExit; - FOldDrawerEdtSearchExit := frmDrawers.edtSearch.OnExit; - frmDrawers.edtSearch.OnExit := frmDrawerEdtSearchExit; {Below is a fix for ClearQuest Defect HDS0000948, Kind of Kloogy I looked and looked for side effects and a better solution and this was the best!} @@ -4773,29 +4711,4 @@ end {End of ClearQuest Defect HDS0000948 Fixes} -end; - -procedure TfrmConsults.frmDrawerEdtSearchExit(Sender: TObject); -begin - FOldDrawerEdtSearchExit(Sender); - pnlActionExit(Sender); -end; - -procedure TfrmConsults.frmDrawerPnlTemplatesButtonExit(Sender: TObject); -begin - FOldDrawerPnlTemplatesButtonExit(Sender); - pnlActionExit(Sender); -end; - -procedure TfrmConsults.frmDrawerPnlEncounterButtonExit(Sender: TObject); -begin - FOldDrawerPnlEncounterButtonExit(Sender); - pnlActionExit(Sender); -end; - -procedure TfrmConsults.FormMouseMove(Sender: TObject; Shift: TShiftState; - X, Y: Integer); -begin - inherited; - FMousing := Now; end; @@ -4821,4 +4734,5 @@ initialization + SpecifyFormIsNotADialog(TfrmConsults); uPCEEdit := TPCEData.Create; uPCEShow := TPCEData.Create; Index: cprs/trunk/CPRS-Chart/Consults/fConsultsView.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultsView.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultsView.dfm (revision 829) @@ -1,20 +1,14 @@ -object frmConsultsView: TfrmConsultsView +inherited frmConsultsView: TfrmConsultsView Left = 320 Top = 172 - Width = 414 - Height = 400 BorderIcons = [] Caption = 'List Selected Consults' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + ClientHeight = 373 + ClientWidth = 406 OldCreateOrder = True Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 - object pnlBase: TORAutoPanel + object pnlBase: TORAutoPanel [0] Left = 0 Top = 0 @@ -154,4 +148,5 @@ ListItemsOnly = True LongList = False + LookupPiece = 0 MaxLength = 0 Pieces = '2' @@ -161,4 +156,5 @@ OnKeyPause = cboServiceSelect OnMouseClick = cboServiceSelect + CharsNeedMatch = 1 end object cboGroupBy: TORComboBox @@ -182,4 +178,5 @@ ListItemsOnly = False LongList = False + LookupPiece = 0 MaxLength = 0 Pieces = '2' @@ -187,5 +184,42 @@ SynonymChars = '<>' TabOrder = 5 - end + CharsNeedMatch = 1 + end + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBase' + 'Status = stsDefault') + ( + 'Component = calBeginDate' + 'Status = stsDefault') + ( + 'Component = calEndDate' + 'Status = stsDefault') + ( + 'Component = lstStatus' + 'Status = stsDefault') + ( + 'Component = radSort' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = treService' + 'Status = stsDefault') + ( + 'Component = cboService' + 'Status = stsDefault') + ( + 'Component = cboGroupBy' + 'Status = stsDefault') + ( + 'Component = frmConsultsView' + 'Status = stsDefault')) end object popStatus: TPopupMenu Index: cprs/trunk/CPRS-Chart/Consults/fConsultsView.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultsView.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fConsultsView.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN, - StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus; + StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus, fBase508Form, + VA508AccessibilityManager; type - TfrmConsultsView = class(TForm) + TfrmConsultsView = class(TfrmBase508Form) pnlBase: TORAutoPanel; lblBeginDate: TLabel; @@ -82,6 +83,6 @@ FChanged := False; with radSort do ItemIndex := 1; - //SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP)); {RV} - SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP)); {RV} + //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList); {RV} + FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList); {RV} SortByPiece(TStringList(SvcList), U, 2); {RV} for i := 0 to SvcList.Count - 1 do @@ -103,5 +104,5 @@ cboServiceSelect(frmConsultsView); end; - lstStatus.Items.Assign(SubSetOfStatus); + FastAssign(SubSetOfStatus, lstStatus.Items); CurrentStatus := CurrentContext.Status; if CurrentStatus <> '' then with lstStatus do Index: cprs/trunk/CPRS-Chart/Consults/fCsltNote.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fCsltNote.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fCsltNote.dfm (revision 829) @@ -1,3 +1,3 @@ -object frmCsltNote: TfrmCsltNote +inherited frmCsltNote: TfrmCsltNote Left = 147 Top = 206 @@ -6,15 +6,9 @@ ClientHeight = 189 ClientWidth = 398 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] OldCreateOrder = True Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 - object pnlBase: TORAutoPanel + object pnlBase: TORAutoPanel [0] Left = 0 Top = 0 @@ -69,4 +63,5 @@ ListItemsOnly = True LongList = False + LookupPiece = 0 MaxLength = 0 Pieces = '2,3' @@ -74,5 +69,24 @@ SynonymChars = '<>' TabOrder = 0 + CharsNeedMatch = 1 end end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = pnlBase' + 'Status = stsDefault') + ( + 'Component = cmdOK' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = cboCsltNote' + 'Status = stsDefault') + ( + 'Component = frmCsltNote' + 'Status = stsDefault')) + end end Index: cprs/trunk/CPRS-Chart/Consults/fCsltNote.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fCsltNote.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fCsltNote.pas (revision 829) @@ -4,8 +4,8 @@ uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, - Buttons, ORCtrls, ORfn, ExtCtrls; + Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager; type - TfrmCsltNote = class(TForm) + TfrmCsltNote = class(TfrmBase508Form) cmdOK: TButton; cmdCancel: TButton; Index: cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm (revision 829) @@ -1,26 +1,25 @@ -object frmEditCslt: TfrmEditCslt +inherited frmEditCslt: TfrmEditCslt Tag = 110 Left = 409 Top = 225 - Width = 569 - Height = 367 + Width = 599 + Height = 375 HorzScrollBar.Range = 561 VertScrollBar.Range = 340 - AutoScroll = False Caption = 'Edit/Resubmit a Cancelled Consult' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + Constraints.MinHeight = 371 + Constraints.MinWidth = 573 OldCreateOrder = True Position = poScreenCenter + ExplicitLeft = 409 + ExplicitTop = 225 + ExplicitWidth = 599 + ExplicitHeight = 375 DesignSize = ( - 561 - 340) + 591 + 341) PixelsPerInch = 96 TextHeight = 13 - object lblService: TLabel + object lblService: TLabel [0] Left = 4 Top = 4 @@ -29,5 +28,5 @@ Caption = 'Consult to Service/Specialty' end - object lblReason: TLabel + object lblReason: TLabel [1] Left = 4 Top = 166 @@ -36,5 +35,5 @@ Caption = 'Reason for Consult' end - object lblComment: TLabel + object lblComment: TLabel [2] Left = 4 Top = 105 @@ -43,5 +42,5 @@ Caption = 'New Comments:' end - object lblComments: TLabel + object lblComments: TLabel [3] Left = 4 Top = 51 @@ -50,5 +49,5 @@ Caption = 'Display Comments:' end - object lblUrgency: TStaticText + object lblUrgency: TStaticText [4] Left = 196 Top = 4 @@ -58,5 +57,5 @@ TabOrder = 16 end - object lblPlace: TStaticText + object lblPlace: TStaticText [5] Left = 376 Top = 41 @@ -66,5 +65,5 @@ TabOrder = 17 end - object lblAttn: TStaticText + object lblAttn: TStaticText [6] Left = 376 Top = 4 @@ -74,5 +73,5 @@ TabOrder = 18 end - object lblProvDiag: TStaticText + object lblProvDiag: TStaticText [7] Left = 195 Top = 82 @@ -82,5 +81,5 @@ TabOrder = 19 end - object lblInpOutp: TStaticText + object lblInpOutp: TStaticText [8] Left = 197 Top = 47 @@ -90,9 +89,9 @@ TabOrder = 20 end - object memReason: TRichEdit + object memReason: TRichEdit [9] Left = 4 Top = 179 - Width = 552 - Height = 129 + Width = 589 + Height = 137 Anchors = [akLeft, akTop, akRight, akBottom] Font.Charset = DEFAULT_CHARSET @@ -111,9 +110,10 @@ OnKeyPress = memCommentKeyPress OnKeyUp = memCommentKeyUp - end - object pnlMessage: TPanel - Left = 21 - Top = 292 - Width = 381 + ExplicitHeight = 136 + end + object pnlMessage: TPanel [10] + Left = 16 + Top = 294 + Width = 418 Height = 44 Anchors = [akLeft, akRight, akBottom] @@ -146,5 +146,5 @@ end end - object cboService: TORComboBox + object cboService: TORComboBox [11] Left = 4 Top = 19 @@ -176,5 +176,5 @@ CharsNeedMatch = 1 end - object cboUrgency: TORComboBox + object cboUrgency: TORComboBox [12] Left = 196 Top = 19 @@ -200,5 +200,5 @@ CharsNeedMatch = 1 end - object radInpatient: TRadioButton + object radInpatient: TRadioButton [13] Left = 197 Top = 61 @@ -209,5 +209,5 @@ OnClick = radInpatientClick end - object radOutpatient: TRadioButton + object radOutpatient: TRadioButton [14] Left = 269 Top = 61 @@ -218,8 +218,8 @@ OnClick = radOutpatientClick end - object cboPlace: TORComboBox + object cboPlace: TORComboBox [15] Left = 376 Top = 54 - Width = 179 + Width = 216 Height = 21 Anchors = [akLeft, akTop, akRight] @@ -243,8 +243,8 @@ CharsNeedMatch = 1 end - object txtProvDiag: TCaptionEdit + object txtProvDiag: TCaptionEdit [16] Left = 195 Top = 95 - Width = 309 + Width = 346 Height = 21 Anchors = [akLeft, akTop, akRight] @@ -257,8 +257,8 @@ Caption = 'Provisional Diagnosis' end - object txtAttn: TORComboBox + object txtAttn: TORComboBox [17] Left = 376 Top = 19 - Width = 181 + Width = 218 Height = 21 Anchors = [akLeft, akTop, akRight] @@ -283,5 +283,5 @@ CharsNeedMatch = 1 end - object cboCategory: TORComboBox + object cboCategory: TORComboBox [18] Left = 561 Top = 103 @@ -305,7 +305,7 @@ CharsNeedMatch = 1 end - object cmdAccept: TButton - Left = 407 - Top = 313 + object cmdAccept: TButton [19] + Left = 437 + Top = 319 Width = 72 Height = 21 @@ -315,7 +315,7 @@ OnClick = cmdAcceptClick end - object cmdQuit: TButton - Left = 484 - Top = 313 + object cmdQuit: TButton [20] + Left = 514 + Top = 319 Width = 72 Height = 21 @@ -326,8 +326,8 @@ OnClick = cmdQuitClick end - object memComment: TRichEdit + object memComment: TRichEdit [21] Left = 4 Top = 121 - Width = 550 + Width = 587 Height = 41 Anchors = [akLeft, akTop, akRight] @@ -340,5 +340,5 @@ OnKeyUp = memCommentKeyUp end - object btnCmtCancel: TButton + object btnCmtCancel: TButton [22] Left = 110 Top = 49 @@ -349,5 +349,5 @@ OnClick = btnCmtCancelClick end - object btnCmtOther: TButton + object btnCmtOther: TButton [23] Left = 110 Top = 75 @@ -358,6 +358,6 @@ OnClick = btnCmtOtherClick end - object cmdLexSearch: TButton - Left = 508 + object cmdLexSearch: TButton [24] + Left = 545 Top = 95 Width = 46 @@ -367,4 +367,76 @@ TabOrder = 9 OnClick = cmdLexSearchClick + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = lblUrgency' + 'Status = stsDefault') + ( + 'Component = lblPlace' + 'Status = stsDefault') + ( + 'Component = lblAttn' + 'Status = stsDefault') + ( + 'Component = lblProvDiag' + 'Status = stsDefault') + ( + 'Component = lblInpOutp' + 'Status = stsDefault') + ( + 'Component = memReason' + 'Status = stsDefault') + ( + 'Component = pnlMessage' + 'Status = stsDefault') + ( + 'Component = memMessage' + 'Status = stsDefault') + ( + 'Component = cboService' + 'Status = stsDefault') + ( + 'Component = cboUrgency' + 'Status = stsDefault') + ( + 'Component = radInpatient' + 'Status = stsDefault') + ( + 'Component = radOutpatient' + 'Status = stsDefault') + ( + 'Component = cboPlace' + 'Status = stsDefault') + ( + 'Component = txtProvDiag' + 'Status = stsDefault') + ( + 'Component = txtAttn' + 'Status = stsDefault') + ( + 'Component = cboCategory' + 'Status = stsDefault') + ( + 'Component = cmdAccept' + 'Status = stsDefault') + ( + 'Component = cmdQuit' + 'Status = stsDefault') + ( + 'Component = memComment' + 'Status = stsDefault') + ( + 'Component = btnCmtCancel' + 'Status = stsDefault') + ( + 'Component = btnCmtOther' + 'Status = stsDefault') + ( + 'Component = cmdLexSearch' + 'Status = stsDefault') + ( + 'Component = frmEditCslt' + 'Status = stsDefault')) end object mnuPopProvDx: TPopupMenu Index: cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas (revision 829) @@ -6,8 +6,8 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons, - Menus ; + Menus, fBase508Form, VA508AccessibilityManager; type - TfrmEditCslt = class(TForm) + TfrmEditCslt = class(TfrmBase508Form) cboService: TORComboBox; cboUrgency: TORComboBox; @@ -169,5 +169,5 @@ begin FChanging := True; - Defaults.Assign(ODForConsults); + FastAssign(ODForConsults, Defaults); FLastServiceID := ''; cboService.Items.Clear; @@ -185,5 +185,5 @@ end; StatusText('Initializing Long List'); - SvcList.Assign(LoadServiceList(CN_SVC_LIST_ORD)) ; + FastAssign(LoadServiceList(CN_SVC_LIST_ORD), SvcList) ; with cboService do begin @@ -203,5 +203,5 @@ ProvDx.CodeInactive := True; end; - memReason.Lines.Assign(OldRec.RequestReason); + QuickCopy(OldRec.RequestReason, memReason); memComment.Clear ; btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0); @@ -388,9 +388,9 @@ RequestReason.Clear else - RequestReason.Assign(Lines); + QuickCopy(memReason, RequestReason); with memComment do if GetTextLen > 0 then - NewComments.Assign(Lines) + QuickCopy(memComment, NewComments) else NewComments.Clear; @@ -443,7 +443,9 @@ AStringList := TStringList.Create; try - AStringList.Assign(memReason.Lines); + //QuickCopy(memReason, AStringList); + AStringList.Text := memReason.Text; LimitStringLength(AStringList, 74); - memReason.Lines.Assign(AstringList); + //QuickCopy(AstringList, memReason); + memReason.Text := AStringList.Text; ControlChange(Self); finally Index: cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm (revision 829) @@ -1,26 +1,25 @@ -object frmEditProc: TfrmEditProc +inherited frmEditProc: TfrmEditProc Tag = 112 Left = 296 Top = 245 - Width = 569 - Height = 335 + Width = 571 + Height = 359 HorzScrollBar.Range = 561 VertScrollBar.Range = 308 - AutoScroll = False Caption = 'Edit and resubmit a cancelled procedure' - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + Constraints.MinHeight = 359 + Constraints.MinWidth = 571 OldCreateOrder = True Position = poScreenCenter + ExplicitLeft = 296 + ExplicitTop = 245 + ExplicitWidth = 571 + ExplicitHeight = 359 DesignSize = ( - 561 - 308) + 563 + 325) PixelsPerInch = 96 TextHeight = 13 - object lblProc: TLabel + object lblProc: TLabel [0] Left = 3 Top = 7 @@ -29,5 +28,5 @@ Caption = 'Procedure' end - object lblReason: TLabel + object lblReason: TLabel [1] Left = 3 Top = 167 @@ -36,5 +35,5 @@ Caption = 'Reason for Consult' end - object lblService: TOROffsetLabel + object lblService: TOROffsetLabel [2] Left = 3 Top = 49 @@ -47,5 +46,5 @@ WordWrap = False end - object lblComment: TLabel + object lblComment: TLabel [3] Left = 106 Top = 109 @@ -54,5 +53,5 @@ Caption = 'New Comments' end - object lblComments: TLabel + object lblComments: TLabel [4] Left = 3 Top = 99 @@ -61,5 +60,5 @@ Caption = 'Display Comments:' end - object lblUrgency: TStaticText + object lblUrgency: TStaticText [5] Left = 190 Top = 7 @@ -69,5 +68,5 @@ TabOrder = 18 end - object lblPlace: TStaticText + object lblPlace: TStaticText [6] Left = 362 Top = 50 @@ -77,5 +76,5 @@ TabOrder = 19 end - object lblAttn: TStaticText + object lblAttn: TStaticText [7] Left = 362 Top = 7 @@ -85,5 +84,5 @@ TabOrder = 20 end - object lblProvDiag: TStaticText + object lblProvDiag: TStaticText [8] Left = 190 Top = 81 @@ -93,5 +92,5 @@ TabOrder = 21 end - object lblInpOutp: TStaticText + object lblInpOutp: TStaticText [9] Left = 192 Top = 48 @@ -101,9 +100,9 @@ TabOrder = 17 end - object memReason: TRichEdit + object memReason: TRichEdit [10] Left = 2 Top = 181 - Width = 555 - Height = 95 + Width = 557 + Height = 119 Anchors = [akLeft, akTop, akRight, akBottom] Font.Charset = DEFAULT_CHARSET @@ -123,7 +122,7 @@ OnKeyUp = memCommentKeyUp end - object cmdAccept: TButton - Left = 399 - Top = 282 + object cmdAccept: TButton [11] + Left = 401 + Top = 303 Width = 72 Height = 21 @@ -133,7 +132,7 @@ OnClick = cmdAcceptClick end - object cmdQuit: TButton - Left = 484 - Top = 282 + object cmdQuit: TButton [12] + Left = 486 + Top = 303 Width = 72 Height = 21 @@ -144,5 +143,5 @@ OnClick = cmdQuitClick end - object cboUrgency: TORComboBox + object cboUrgency: TORComboBox [13] Left = 190 Top = 22 @@ -168,5 +167,5 @@ CharsNeedMatch = 1 end - object radInpatient: TRadioButton + object radInpatient: TRadioButton [14] Left = 190 Top = 61 @@ -177,5 +176,5 @@ OnClick = radInpatientClick end - object radOutpatient: TRadioButton + object radOutpatient: TRadioButton [15] Left = 264 Top = 61 @@ -186,8 +185,8 @@ OnClick = radOutpatientClick end - object cboPlace: TORComboBox + object cboPlace: TORComboBox [16] Left = 362 Top = 63 - Width = 195 + Width = 197 Height = 21 Anchors = [akLeft, akTop, akRight] @@ -210,9 +209,10 @@ OnChange = ControlChange CharsNeedMatch = 1 - end - object txtProvDiag: TCaptionEdit + ExplicitWidth = 195 + end + object txtProvDiag: TCaptionEdit [17] Left = 190 Top = 94 - Width = 313 + Width = 315 Height = 21 Anchors = [akLeft, akTop, akRight] @@ -225,8 +225,8 @@ Caption = 'Provisional Diagnosis' end - object txtAttn: TORComboBox + object txtAttn: TORComboBox [18] Left = 362 Top = 22 - Width = 195 + Width = 197 Height = 21 Anchors = [akLeft, akTop, akRight] @@ -250,6 +250,7 @@ OnNeedData = txtAttnNeedData CharsNeedMatch = 1 - end - object cboProc: TORComboBox + ExplicitWidth = 195 + end + object cboProc: TORComboBox [19] Left = 3 Top = 22 @@ -283,5 +284,5 @@ CharsNeedMatch = 1 end - object cboCategory: TORComboBox + object cboCategory: TORComboBox [20] Left = 505 Top = -11 @@ -306,5 +307,5 @@ CharsNeedMatch = 1 end - object cboService: TORComboBox + object cboService: TORComboBox [21] Left = 3 Top = 65 @@ -337,8 +338,8 @@ CharsNeedMatch = 1 end - object memComment: TRichEdit + object memComment: TRichEdit [22] Left = 106 Top = 123 - Width = 449 + Width = 451 Height = 38 Anchors = [akLeft, akTop, akRight] @@ -349,8 +350,8 @@ OnKeyUp = memCommentKeyUp end - object pnlMessage: TPanel - Left = 29 - Top = 264 - Width = 381 + object pnlMessage: TPanel [23] + Left = 19 + Top = 276 + Width = 383 Height = 44 Anchors = [akLeft, akRight, akBottom] @@ -383,5 +384,5 @@ end end - object btnCmtCancel: TButton + object btnCmtCancel: TButton [24] Left = 11 Top = 116 @@ -392,5 +393,5 @@ OnClick = btnCmtCancelClick end - object btnCmtOther: TButton + object btnCmtOther: TButton [25] Left = 11 Top = 139 @@ -401,6 +402,6 @@ OnClick = btnCmtOtherClick end - object cmdLexSearch: TButton - Left = 507 + object cmdLexSearch: TButton [26] + Left = 509 Top = 94 Width = 49 @@ -410,4 +411,79 @@ TabOrder = 8 OnClick = cmdLexSearchClick + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = lblUrgency' + 'Status = stsDefault') + ( + 'Component = lblPlace' + 'Status = stsDefault') + ( + 'Component = lblAttn' + 'Status = stsDefault') + ( + 'Component = lblProvDiag' + 'Status = stsDefault') + ( + 'Component = lblInpOutp' + 'Status = stsDefault') + ( + 'Component = memReason' + 'Status = stsDefault') + ( + 'Component = cmdAccept' + 'Status = stsDefault') + ( + 'Component = cmdQuit' + 'Status = stsDefault') + ( + 'Component = cboUrgency' + 'Status = stsDefault') + ( + 'Component = radInpatient' + 'Status = stsDefault') + ( + 'Component = radOutpatient' + 'Status = stsDefault') + ( + 'Component = cboPlace' + 'Status = stsDefault') + ( + 'Component = txtProvDiag' + 'Status = stsDefault') + ( + 'Component = txtAttn' + 'Status = stsDefault') + ( + 'Component = cboProc' + 'Status = stsDefault') + ( + 'Component = cboCategory' + 'Status = stsDefault') + ( + 'Component = cboService' + 'Status = stsDefault') + ( + 'Component = memComment' + 'Status = stsDefault') + ( + 'Component = pnlMessage' + 'Status = stsDefault') + ( + 'Component = memMessage' + 'Status = stsDefault') + ( + 'Component = btnCmtCancel' + 'Status = stsDefault') + ( + 'Component = btnCmtOther' + 'Status = stsDefault') + ( + 'Component = cmdLexSearch' + 'Status = stsDefault') + ( + 'Component = frmEditProc' + 'Status = stsDefault')) end object mnuPopProvDx: TPopupMenu Index: cprs/trunk/CPRS-Chart/Consults/fEditProc.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fEditProc.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fEditProc.pas (revision 829) @@ -6,8 +6,8 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons, - Menus; + Menus, fBase508Form, VA508AccessibilityManager; type - TfrmEditProc = class(TForm) + TfrmEditProc = class(TfrmBase508Form) cmdAccept: TButton; cmdQuit: TButton; @@ -167,5 +167,5 @@ FChanging := True; Defaults := TStringList.Create; - Defaults.Assign(ODForProcedures); + FastAssign(ODForProcedures, Defaults); FLastProcID := ''; cboProc.InitLongList(OldRec.ConsultProcName) ; @@ -206,5 +206,5 @@ ProvDx.CodeInactive := True; end; - memReason.Lines.Assign(OldRec.RequestReason); + QuickCopy(OldRec.RequestReason, memReason); btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0); btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0); @@ -394,9 +394,9 @@ RequestReason.Clear else - RequestReason.Assign(Lines); + QuickCopy(memReason, RequestReason); with memComment do if GetTextLen > 0 then - NewComments.Assign(Lines) + QuickCopy(memComment, NewComments) else NewComments.Clear; @@ -443,5 +443,5 @@ begin Clear; - Items.Assign(GetProcedureServices(cboProc.ItemIEN)); + FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items); if Items.Count > 0 then begin @@ -471,7 +471,9 @@ AStringList := TStringList.Create; try - AStringList.Assign(memReason.Lines); + //QuickCopy(memReason, AStringList); + AStringList.Text := memReason.Text; LimitStringLength(AStringList, 74); - memReason.Lines.Assign(AstringList); + //QuickCopy(AstringList, memReason); + memReason.Text := AStringList.Text; ControlChange(Self); finally Index: cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm (revision 829) @@ -11,4 +11,6 @@ Constraints.MinWidth = 606 Font.Charset = ANSI_CHARSET + ExplicitWidth = 606 + ExplicitHeight = 376 PixelsPerInch = 96 TextHeight = 13 @@ -20,12 +22,44 @@ Caption = 'Consult to Service/Specialty' end - object pnlReason: TPanel [1] + object lblProvDiag: TLabel [1] + Left = 309 + Top = 81 + Width = 100 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Provisional Diagnosis' + end + object lblUrgency: TLabel [2] + Left = 309 + Top = 2 + Width = 40 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Urgency' + end + object lblPlace: TLabel [3] + Left = 454 + Top = 43 + Width = 100 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Place of Consultation' + end + object lblAttn: TLabel [4] + Left = 454 + Top = 2 + Width = 42 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Attention' + end + object pnlReason: TPanel [5] Left = 3 - Top = 154 + Top = 128 Width = 585 - Height = 135 + Height = 161 Anchors = [akLeft, akTop, akRight] BevelOuter = bvNone - TabOrder = 11 + TabOrder = 10 object lblReason: TLabel Left = 0 @@ -35,4 +69,5 @@ Align = alTop Caption = 'Reason for Request' + ExplicitWidth = 95 end object memReason: TRichEdit @@ -40,5 +75,5 @@ Top = 13 Width = 585 - Height = 122 + Height = 148 Align = alClient Font.Charset = ANSI_CHARSET @@ -60,40 +95,4 @@ end end - object lblUrgency: TStaticText [2] - Left = 309 - Top = 2 - Width = 44 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Urgency' - TabOrder = 17 - end - object lblPlace: TStaticText [3] - Left = 454 - Top = 43 - Width = 104 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Place of Consultation' - TabOrder = 18 - end - object lblAttn: TStaticText [4] - Left = 454 - Top = 2 - Width = 46 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Attention' - TabOrder = 19 - end - object lblProvDiag: TStaticText [5] - Left = 309 - Top = 81 - Width = 104 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Provisional Diagnosis' - TabOrder = 20 - end inherited memOrder: TCaptionMemo Left = 3 @@ -101,4 +100,6 @@ Width = 417 Height = 41 + TabStop = True + Anchors = [akLeft, akBottom] Lines.Strings = ( 'The order text...' @@ -106,28 +107,11 @@ '--------------------------------' 'An order message may be displayed here.') - TabOrder = 1 - end - inherited cmdAccept: TButton - Left = 427 - Top = 315 - TabOrder = 12 - end - inherited cmdQuit: TButton - Left = 531 - Top = 315 - Width = 61 - TabOrder = 13 - end - inherited pnlMessage: TPanel - Left = 13 - Top = 295 - Width = 377 - Anchors = [akLeft, akRight, akBottom] - TabOrder = 14 - inherited memMessage: TRichEdit - Width = 292 - end - end - object cboService: TORComboBox + TabOrder = 11 + ExplicitLeft = 3 + ExplicitTop = 305 + ExplicitWidth = 417 + ExplicitHeight = 41 + end + object cboService: TORComboBox [7] Left = 0 Top = 16 @@ -151,4 +135,5 @@ SynonymChars = '<>' TabOrder = 0 + TabStop = True OnChange = ControlChange OnClick = cboServiceSelect @@ -158,5 +143,5 @@ CharsNeedMatch = 1 end - object cboUrgency: TORComboBox + object cboUrgency: TORComboBox [8] Left = 309 Top = 16 @@ -166,5 +151,4 @@ Style = orcsDropDown AutoSelect = True - Caption = 'Urgency' Color = clWindow DropDownCount = 8 @@ -179,10 +163,10 @@ Sorted = False SynonymChars = '<>' - TabOrder = 4 + TabOrder = 3 TabStop = True OnChange = ControlChange CharsNeedMatch = 1 end - object cboPlace: TORComboBox + object cboPlace: TORComboBox [9] Left = 454 Top = 56 @@ -192,5 +176,4 @@ Style = orcsDropDown AutoSelect = True - Caption = 'Place of Consultation' Color = clWindow DropDownCount = 8 @@ -205,9 +188,9 @@ Sorted = False SynonymChars = '<>' - TabOrder = 7 + TabOrder = 6 OnChange = ControlChange CharsNeedMatch = 1 end - object txtProvDiag: TCaptionEdit + object txtProvDiag: TCaptionEdit [10] Left = 309 Top = 94 @@ -219,9 +202,8 @@ PopupMenu = mnuPopProvDx ShowHint = True - TabOrder = 9 + TabOrder = 8 OnChange = txtProvDiagChange - Caption = 'Provisional Diagnosis' - end - object txtAttn: TORComboBox + end + object txtAttn: TORComboBox [11] Left = 454 Top = 16 @@ -231,5 +213,4 @@ Style = orcsDropDown AutoSelect = True - Caption = 'Attention' Color = clWindow DropDownCount = 8 @@ -244,10 +225,10 @@ Sorted = False SynonymChars = '<>' - TabOrder = 5 + TabOrder = 4 OnChange = ControlChange OnNeedData = txtAttnNeedData CharsNeedMatch = 1 end - object treService: TORTreeView + object treService: TORTreeView [12] Left = 0 Top = 38 @@ -264,16 +245,16 @@ ParentFont = False ReadOnly = True - TabOrder = 3 + TabOrder = 2 Visible = False OnChange = treServiceChange OnCollapsing = treServiceCollapsing + OnEnter = treServiceEnter OnExit = treServiceExit OnKeyDown = treServiceKeyDown OnKeyUp = treServiceKeyUp OnMouseDown = treServiceMouseDown - Caption = 'object lblService: TLabel' NodePiece = 0 end - object cboCategory: TORComboBox + object cboCategory: TORComboBox [13] Left = 225 Top = -5 @@ -297,5 +278,5 @@ CharsNeedMatch = 1 end - object pnlServiceTreeButton: TKeyClickPanel + object pnlServiceTreeButton: TKeyClickPanel [14] Left = 274 Top = 14 @@ -313,5 +294,5 @@ Font.Style = [] ParentFont = False - TabOrder = 2 + TabOrder = 1 TabStop = True OnClick = btnServiceTreeClick @@ -323,4 +304,5 @@ Width = 22 Height = 22 + Hint = 'View services/specialties hierarchically' Glyph.Data = { 26050000424D26050000000000003604000028000000100000000F0000000100 @@ -367,8 +349,10 @@ FFFFFFFFFFFFFFFFFFFF} Margin = 0 + ParentShowHint = False + ShowHint = True OnClick = btnServiceTreeClick end end - object cmdLexSearch: TButton + object cmdLexSearch: TButton [15] Left = 543 Top = 94 @@ -377,8 +361,8 @@ Anchors = [akTop, akRight] Caption = 'Lexicon' - TabOrder = 10 + TabOrder = 9 OnClick = cmdLexSearchClick end - object gbInptOpt: TGroupBox + object gbInptOpt: TGroupBox [16] Left = 309 Top = 35 @@ -387,5 +371,5 @@ Anchors = [akTop, akRight] Caption = 'Patient will be seen as an:' - TabOrder = 6 + TabOrder = 5 object radInpatient: TRadioButton Left = 3 @@ -407,5 +391,5 @@ end end - object btnDiagnosis: TButton + object btnDiagnosis: TButton [17] Left = 543 Top = 95 @@ -414,6 +398,109 @@ Anchors = [akTop, akRight] Caption = 'Diagnosis' - TabOrder = 8 + TabOrder = 7 OnClick = btnDiagnosisClick + end + inherited cmdAccept: TButton + Left = 439 + Top = 315 + Anchors = [akLeft, akBottom] + TabOrder = 12 + ExplicitLeft = 439 + ExplicitTop = 315 + end + inherited cmdQuit: TButton + Left = 531 + Top = 315 + Width = 61 + Anchors = [akLeft, akBottom] + TabOrder = 13 + ExplicitLeft = 531 + ExplicitTop = 315 + ExplicitWidth = 61 + end + inherited pnlMessage: TPanel + Left = 13 + Top = 295 + Width = 377 + Anchors = [akLeft, akRight, akBottom] + TabOrder = 14 + ExplicitLeft = 13 + ExplicitTop = 295 + ExplicitWidth = 377 + inherited memMessage: TRichEdit + Width = 292 + ExplicitWidth = 292 + end + 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') + ( + 'Component = cmdAccept' + 'Status = stsDefault') + ( + 'Component = cmdQuit' + 'Status = stsDefault') + ( + 'Component = pnlMessage' + 'Status = stsDefault') + ( + 'Component = memMessage' + 'Status = stsDefault') + ( + 'Component = frmODCslt' + 'Status = stsDefault')) end object mnuPopProvDx: TPopupMenu Index: cprs/trunk/CPRS-Chart/Consults/fODConsult.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fODConsult.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fODConsult.pas (revision 829) @@ -8,5 +8,6 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons, - Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet ; + Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet, + VA508AccessibilityManager ; type @@ -18,8 +19,8 @@ txtAttn: TORComboBox; lblService: TLabel; - lblUrgency: TStaticText; - lblPlace: TStaticText; - lblAttn: TStaticText; - lblProvDiag: TStaticText; + lblUrgency: TLabel; + lblPlace: TLabel; + lblAttn: TLabel; + lblProvDiag: TLabel; treService: TORTreeView; cboCategory: TORComboBox; @@ -86,4 +87,6 @@ procedure cmdQuitClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormResize(Sender: TObject); + procedure treServiceEnter(Sender: TObject); private @@ -103,4 +106,5 @@ procedure SaveConsultDxForNurse(pDiagnosis: string); // save the dx entered by nurese if Master BA switch is ON procedure SetUpCopyConsultDiagnoses(pOrderID:string); + procedure AdjustMemReasonSize; protected procedure InitDialog; override; @@ -125,5 +129,5 @@ uses rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq, - ORClasses, clipbrd, uTemplates, fFrame, uODBase; + ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility; var @@ -153,4 +157,8 @@ TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.'; + TX_SVC_HRCHY = 'services/specialties hierarchy'; + TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically'; + TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view'; + procedure TfrmODCslt.FormCreate(Sender: TObject); begin @@ -180,5 +188,5 @@ Responses.Dialog := 'GMRCOR CONSULT'; // loads formatting info StatusText('Loading Default Values'); - Defaults.Assign(ODForConsults); // ODForConsults returns TStrings with defaults + FastAssign(ODForConsults, Defaults); // ODForConsults returns TStrings with defaults CtrlInits.LoadDefaults(Defaults); txtAttn.InitLongList('') ; @@ -229,6 +237,6 @@ btnServiceTree.Enabled := True; pnlServiceTreeButton.Enabled := True; - ActiveControl := cboService; SetProvDiagPromptingMode; + ActiveControl := cboService; // set after call to SetProvDiagPromptingMode Changing := False; StatusText(''); @@ -240,4 +248,7 @@ 'Please contact your Clinical Coordinator/IRM staff to fix this order.'; TX_INACTIVE_SVC_CAP = 'Inactive Service'; + TX_NO_SVC = 'The order or quick order you have selected does not specify a consult service.' + CRLF + + 'Please contact your Clinical Coordinator/IRM staff to fix this order.'; + TC_NO_SVC = 'No service specified'; var i:integer; @@ -254,5 +265,13 @@ Changing := True; tmpResp := TResponse(FindResponseByName('ORDERABLE',1)); - SvcIEN := GetServiceIEN(tmpResp.IValue); + if tmpResp <> nil then + SvcIEN := GetServiceIEN(tmpResp.IValue) + else + begin + InfoBox(TX_NO_SVC, TC_NO_SVC, MB_ICONERROR or MB_OK); + AbortOrder := True; + Close; + Exit; + end; if SvcIEN = '-1' then begin @@ -284,6 +303,20 @@ SetProvDiagPromptingMode; GetProvDxandValidateCode(Responses); + SetTemplateDialogCanceled(FALSE); SetControl(memReason, 'COMMENT', 1); + if WasTemplateDialogCanceled then + begin + AbortOrder := True; + Close; + Exit; + end; + SetTemplateDialogCanceled(FALSE); SetupReasonForRequest(OrderAction); + if WasTemplateDialogCanceled then + begin + AbortOrder := True; + Close; + Exit; + end; Changing := False; ControlChange(Self); @@ -292,6 +325,6 @@ begin if QuickList.Count > 0 then BuildQuickTree(QuickList, '0', nil) ; - SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD)); {RV} - AList.Assign(SvcList); + FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD), SvcList); {RV} + FastAssign(SvcList, AList); SortByPiece(AList, U, 2); BuildServiceTree(treService, SvcList, '0', nil) ; @@ -308,5 +341,5 @@ if QuickList.Count > 0 then with cboService do begin - Items.Assign(QuickList); + FastAssign(QuickList, cboService.Items); Items.Add(LLS_LINE); Items.Add(LLS_SPACE); @@ -338,5 +371,5 @@ Exit; end; - memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True)); + QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); end; PreserveControl(treService); @@ -555,7 +588,14 @@ SetControl(cboPlace, 'PLACE', 1); SetControl(txtAttn, 'PROVIDER', 1); + SetTemplateDialogCanceled(FALSE); SetControl(memReason, 'COMMENT', 1); + if WasTemplateDialogCanceled and OrderContainsObjects then + begin + AbortOrder := TRUE; + Close; + Exit; + end; if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then - memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True)); + QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); SetupReasonForRequest(ORDER_QUICK); GetProvDxandValidateCode(Responses); @@ -571,5 +611,5 @@ Exit; end; - memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True)); + QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); SetupReasonForRequest(ORDER_NEW); end; @@ -620,7 +660,14 @@ end; +procedure TfrmODCslt.treServiceEnter(Sender: TObject); +begin + inherited; + cmdQuit.Cancel := FALSE; +end; + procedure TfrmODCslt.treServiceExit(Sender: TObject); begin inherited; + cmdQuit.Cancel := TRUE; with cboService do begin @@ -688,7 +735,9 @@ AStringList := TStringList.Create; try - AStringList.Assign(memReason.Lines); + //QuickCopy(memReason, AStringList); + AStringList.Text := memReason.Text; LimitStringLength(AStringList, 74); - memReason.Lines.Assign(AstringList); + //QuickCopy(AstringList, memReason); + memReason.Text := AStringList.Text; ControlChange(Self); finally @@ -762,7 +811,14 @@ SetControl(cboPlace, 'PLACE', 1); SetControl(txtAttn, 'PROVIDER', 1); + SetTemplateDialogCanceled(FALSE); SetControl(memReason, 'COMMENT', 1); + if WasTemplateDialogCanceled and OrderContainsObjects then + begin + AbortOrder := TRUE; + Close; + Exit; + end; // if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then -// memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True)); +// QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); SetupReasonForRequest(ORDER_QUICK); GetProvDxandValidateCode(Responses); @@ -779,5 +835,5 @@ Exit; end; - memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True)); + QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); SetupReasonForRequest(ORDER_NEW); Changing := False; @@ -824,4 +880,8 @@ if treService.Visible then begin + // for some reason screen reader is reading caption when tree view is not visible + treService.Caption := TX_SVC_HRCHY; + pnlServiceTreeButton.Caption := TX_CLOSE_SVC_HRCHY; + btnServiceTree.Hint := TX_CLOSE_SVC_HRCHY; treService.SetFocus; with treService do for i := 0 to Items.Count-1 do @@ -834,4 +894,11 @@ end; end; + end + else + begin + treService.Caption := ''; + pnlServiceTreeButton.Caption := TX_VIEW_SVC_HRCHY; + btnServiceTree.Hint := TX_VIEW_SVC_HRCHY; + pnlServiceTreeButton.SetFocus; end; Changing := False; @@ -863,5 +930,4 @@ txtProvDiag.Enabled := False; txtProvDiag.Font.Color := clGrayText; - lblProvDiag.Enabled := False; txtProvDiag.ReadOnly := True; txtProvDiag.Color := clBtnFace; @@ -940,5 +1006,4 @@ txtProvDiag.Color := clBtnFace; txtProvDiag.Font.Color := clBtnText; - lblProvDiag.Enabled := False; txtProvDiag.Hint := ''; if cboService.ItemIEN = 0 then Exit; @@ -962,5 +1027,4 @@ txtProvDiag.Color := clBtnFace; txtProvDiag.Font.Color := clBtnText; - lblProvDiag.Enabled := False; end else @@ -972,5 +1036,4 @@ txtProvDiag.Color := clWindow; txtProvDiag.Font.Color := clWindowText; - lblProvDiag.Enabled := True; end; 'L': begin @@ -989,5 +1052,4 @@ txtProvDiag.Color := clInfoBk; txtProvDiag.Font.Color := clInfoText; - lblProvDiag.Enabled := True; end; end; @@ -1037,5 +1099,5 @@ begin if ((OrderAction = ORDER_QUICK) and (cboService.ItemID <> '') and (Length(memReason.Text) = 0)) then - memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True)); + QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); EditReason := GMRCREAF; if EditReason = '' then EditReason := ReasonForRequestEditable(cboService.ItemID + CSLT_PTR); @@ -1065,5 +1127,5 @@ if ItemIEN > 0 then begin - Alist.Assign(GetServicePrerequisites(ItemID + CSLT_PTR)); + FastAssign(GetServicePrerequisites(ItemID + CSLT_PTR), Alist); if AList.Count > 0 then begin @@ -1154,5 +1216,5 @@ try Result := GetDefaultReasonForRequest(Service + CSLT_PTR, Resolve); - TmpSL.Assign(Result); + FastAssign(Result, TmpSL); x := TmpSL.Text; ExpandOrderObjects(x, HasObjects); @@ -1160,6 +1222,14 @@ Responses.OrderContainsObjects := HasObjects; ExecuteTemplateOrBoilerPlate(TmpSL, cboService.ItemIEN , ltConsult, nil, 'Reason for Request: ' + cboService.DisplayText[cboService.ItemIndex], DocInfo); - if TmpSL.Text <> x then Responses.OrderContainsObjects := False; - Result.Assign(TmpSL); + AbortOrder := WasTemplateDialogCanceled; + Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects; + if AbortOrder then + begin + Result.Text := ''; + Close; + Exit; + end + else + FastAssignWith508Msg(TmpSL, Result); finally TmpSL.Free; @@ -1190,4 +1260,9 @@ treServiceChange(Sender, treService.Selected); end; + VK_ESCAPE: + begin + key := 0; + btnServiceTreeClick(Self); + end else FKeyBoarding := True; @@ -1406,4 +1481,18 @@ end; +procedure TfrmODCslt.FormResize(Sender: TObject); +begin + inherited; + AdjustMemReasonSize(); +end; + +procedure TfrmODCslt.AdjustMemReasonSize; +const + PIXEL_SPACE = 3; +begin + pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE; + pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE; +end; + end. Index: cprs/trunk/CPRS-Chart/Consults/fODProc.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fODProc.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fODProc.dfm (revision 829) @@ -10,4 +10,8 @@ Constraints.MinHeight = 393 Constraints.MinWidth = 543 + ExplicitLeft = 208 + ExplicitTop = 188 + ExplicitWidth = 543 + ExplicitHeight = 393 PixelsPerInch = 96 TextHeight = 13 @@ -119,4 +123,8 @@ 'An order message may be displayed here.') TabOrder = 1 + ExplicitLeft = 0 + ExplicitTop = 321 + ExplicitWidth = 380 + ExplicitHeight = 41 end object cboUrgency: TORComboBox [9] @@ -271,28 +279,5 @@ CharsNeedMatch = 1 end - inherited cmdAccept: TButton - Left = 387 - Top = 339 - Anchors = [akRight, akBottom] - TabOrder = 10 - end - inherited cmdQuit: TButton - Left = 469 - Top = 339 - Width = 64 - Anchors = [akRight, akBottom] - TabOrder = 11 - end - inherited pnlMessage: TPanel - Left = 50 - Top = 320 - Width = 316 - Anchors = [akLeft, akRight, akBottom] - TabOrder = 12 - inherited memMessage: TRichEdit - Width = 254 - end - end - object cmdLexSearch: TButton + object cmdLexSearch: TButton [15] Left = 486 Top = 93 @@ -304,5 +289,5 @@ OnClick = cmdLexSearchClick end - object gbInptOpt: TGroupBox + object gbInptOpt: TGroupBox [16] Left = 249 Top = 36 @@ -331,5 +316,5 @@ end end - object txtProvDiag: TCaptionEdit + object txtProvDiag: TCaptionEdit [17] Left = 249 Top = 93 @@ -344,4 +329,108 @@ OnChange = txtProvDiagChange Caption = 'Provisional Diagnosis' + end + inherited cmdAccept: TButton + Left = 387 + Top = 339 + Anchors = [akRight, akBottom] + TabOrder = 10 + ExplicitLeft = 387 + ExplicitTop = 339 + end + inherited cmdQuit: TButton + Left = 469 + Top = 339 + Width = 64 + Anchors = [akRight, akBottom] + TabOrder = 11 + ExplicitLeft = 469 + ExplicitTop = 339 + ExplicitWidth = 64 + end + inherited pnlMessage: TPanel + Left = 50 + Top = 320 + Width = 316 + Anchors = [akLeft, akRight, akBottom] + TabOrder = 12 + ExplicitLeft = 50 + ExplicitTop = 320 + ExplicitWidth = 316 + inherited memMessage: TRichEdit + Width = 254 + ExplicitWidth = 254 + end + end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = lblUrgency' + 'Status = stsDefault') + ( + 'Component = lblPlace' + 'Status = stsDefault') + ( + 'Component = lblAttn' + 'Status = stsDefault') + ( + 'Component = lblProvDiag' + 'Status = stsDefault') + ( + 'Component = pnlReason' + 'Status = stsDefault') + ( + 'Component = memReason' + 'Status = stsDefault') + ( + 'Component = cboUrgency' + 'Status = stsDefault') + ( + 'Component = cboPlace' + 'Status = stsDefault') + ( + 'Component = txtAttn' + 'Status = stsDefault') + ( + 'Component = cboProc' + 'Status = stsDefault') + ( + 'Component = cboCategory' + 'Status = stsDefault') + ( + 'Component = cboService' + 'Status = stsDefault') + ( + 'Component = cmdLexSearch' + 'Status = stsDefault') + ( + 'Component = gbInptOpt' + 'Status = stsDefault') + ( + 'Component = radInpatient' + 'Status = stsDefault') + ( + 'Component = radOutpatient' + 'Status = stsDefault') + ( + 'Component = txtProvDiag' + 'Status = stsDefault') + ( + 'Component = memOrder' + 'Status = stsDefault') + ( + 'Component = cmdAccept' + 'Status = stsDefault') + ( + 'Component = cmdQuit' + 'Status = stsDefault') + ( + 'Component = pnlMessage' + 'Status = stsDefault') + ( + 'Component = memMessage' + 'Status = stsDefault') + ( + 'Component = frmODProc' + 'Status = stsDefault')) end object mnuPopProvDx: TPopupMenu Index: cprs/trunk/CPRS-Chart/Consults/fODProc.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fODProc.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fODProc.pas (revision 829) @@ -6,5 +6,5 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons, - Menus; + Menus, VA508AccessibilityManager; type @@ -59,5 +59,4 @@ procedure memReasonKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); - procedure FormDestroy(Sender: TObject); procedure memReasonKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -90,5 +89,6 @@ uses rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses, - clipbrd, fPreReq, uTemplates, uAccessibleRichEdit, fFrame, uODBase; + clipbrd, fPreReq, uTemplates, fFrame, uODBase, + uVA508CPRSCompatibility; var @@ -115,5 +115,4 @@ inherited; DoSetFontSize(MainFontSize); - TAccessibleRichEdit.WrapControl(memReason); AllowQuickOrder := True; FillChar(ProvDx, SizeOf(ProvDx), 0); @@ -188,5 +187,5 @@ SetControl(cboProc, 'ORDERABLE', 1); if cboProc.ItemIndex < 0 then exit; - cboService.Items.Assign(GetProcedureServices(cboProc.ItemIEN)); + FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items); Changing := True; tmpResp := TResponse(FindResponseByName('CLASS',1)); @@ -226,6 +225,20 @@ SetProvDiagPromptingMode; GetProvDxandValidateCode(Responses); + SetTemplateDialogCanceled(FALSE); SetControl(memReason, 'COMMENT', 1); + if WasTemplateDialogCanceled then + begin + AbortOrder := True; + Close; + Exit; + end; + SetTemplateDialogCanceled(FALSE); SetupReasonForRequest(OrderAction); + if WasTemplateDialogCanceled then + begin + AbortOrder := True; + Close; + Exit; + end; Changing := False; OrderMessage(ConsultMessage(cboProc.ItemIEN)); @@ -360,5 +373,5 @@ begin Clear; - Items.Assign(GetProcedureServices(cboProc.ItemIEN)); + FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items); if Items.Count > 1 then ItemIndex := -1 @@ -385,5 +398,5 @@ with cboService do begin - Items.Assign(GetProcedureServices(cboProc.ItemIEN)); + FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items); if Items.Count > 1 then ItemIndex := -1 @@ -402,7 +415,12 @@ SetControl(cboPlace, 'PLACE', 1); SetControl(txtAttn, 'PROVIDER', 1); + SetTemplateDialogCanceled(FALSE); SetControl(memReason, 'COMMENT', 1); -// if ((cboProc.ItemIEN > 0) and (Length(memReason.Text) = 0)) then -// memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True)); + if WasTemplateDialogCanceled and OrderContainsObjects then + begin + AbortOrder := TRUE; + Close; + Exit; + end; SetupReasonForRequest(ORDER_QUICK); GetProvDxandValidateCode(Responses); @@ -441,5 +459,5 @@ Exit; end; - memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True)); + FastAssign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True), memReason.Lines); SetupReasonForRequest(ORDER_NEW); end; @@ -457,7 +475,7 @@ AStringList := TStringList.Create; try - AStringList.Assign(memReason.Lines); + AStringList.Text := memReason.Text; LimitStringLength(AStringList, 74); - memReason.Lines.Assign(AstringList); + memReason.Text := AStringList.Text; ControlChange(Self); finally @@ -662,5 +680,5 @@ begin if ((OrderAction = ORDER_QUICK) and (cboProc.ItemID <> '') and (Length(memReason.Text) = 0)) then - memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True)); + FastAssign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True), memReason.Lines); EditReason := GMRCREAF; if EditReason = '' then EditReason := ReasonForRequestEditable(Piece(cboProc.Items[cboProc.ItemIndex], U, 4)); @@ -690,5 +708,5 @@ if ItemIEN > 0 then begin - Alist.Assign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4))); + FastAssign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4)), Alist); if AList.Count > 0 then begin @@ -708,5 +726,6 @@ end; -function TfrmODProc.DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings; +function TfrmODProc.DefaultReasonForRequest(Service: string; + Resolve: Boolean): TStrings; var TmpSL: TStringList; @@ -720,13 +739,21 @@ try Result := GetDefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), Resolve); - TmpSL.Assign(Result); + FastAssign(Result, TmpSL); x := TmpSL.Text; ExpandOrderObjects(x, HasObjects); TmpSL.Text := x; Responses.OrderContainsObjects := HasObjects; - ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef(piece(piece(cboProc.Items[cboProc.ItemIndex],U,4),';',1),0), + ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef(Piece(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), ';', 1), 0), ltProcedure, nil, 'Reason for Request: ' + cboProc.DisplayText[cboProc.ItemIndex], DocInfo); - if TmpSL.Text <> x then Responses.OrderContainsObjects := False; - Result.Assign(TmpSL); + AbortOrder := WasTemplateDialogCanceled; + Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects; + if AbortOrder then + begin + Result.Text := ''; + Close; + Exit; + end + else + FastAssignWith508Msg(TmpSL, Result); finally TmpSL.Free; @@ -780,10 +807,4 @@ end; -procedure TfrmODProc.FormDestroy(Sender: TObject); -begin - inherited; - TAccessibleRichEdit.UnwrapControl(memReason); -end; - procedure TfrmODProc.SetFontSize(FontSize: integer); begin Index: cprs/trunk/CPRS-Chart/Consults/fPreReq.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fPreReq.dfm (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fPreReq.dfm (revision 829) @@ -1,23 +1,20 @@ -object frmPrerequisites: TfrmPrerequisites +inherited frmPrerequisites: TfrmPrerequisites Left = 337 Top = 219 - Width = 377 - Height = 348 BorderIcons = [biSystemMenu] Caption = 'frmPrerequisites' - Color = clBtnFace + ClientHeight = 319 + ClientWidth = 367 Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] OldCreateOrder = True Position = poScreenCenter + OnActivate = OnActivate OnClose = FormClose OnCreate = FormCreate - OnShow = FormShow + ExplicitWidth = 375 + ExplicitHeight = 346 PixelsPerInch = 96 TextHeight = 13 - object lblFontTest: TLabel + object lblFontTest: TLabel [0] Left = 148 Top = 208 @@ -32,9 +29,9 @@ ParentFont = False end - object memReport: TRichEdit + object memReport: TRichEdit [1] Left = 0 Top = 33 - Width = 369 - Height = 288 + Width = 367 + Height = 286 Align = alClient Color = clCream @@ -53,8 +50,8 @@ WordWrap = False end - object pnlButton: TPanel + object pnlButton: TPanel [2] Left = 0 Top = 0 - Width = 369 + Width = 367 Height = 33 Align = alTop @@ -62,8 +59,8 @@ TabOrder = 2 DesignSize = ( - 369 + 367 33) object cmdContinue: TButton - Left = 209 + Left = 207 Top = 6 Width = 75 @@ -75,5 +72,5 @@ end object cmdCancel: TButton - Left = 292 + Left = 290 Top = 6 Width = 75 @@ -86,5 +83,5 @@ end end - object cmdPrint: TButton + object cmdPrint: TButton [3] Left = 2 Top = 6 @@ -95,4 +92,25 @@ OnClick = cmdPrintClick end + inherited amgrMain: TVA508AccessibilityManager + Data = ( + ( + 'Component = memReport' + 'Status = stsDefault') + ( + 'Component = pnlButton' + 'Status = stsDefault') + ( + 'Component = cmdContinue' + 'Status = stsDefault') + ( + 'Component = cmdCancel' + 'Status = stsDefault') + ( + 'Component = cmdPrint' + 'Status = stsDefault') + ( + 'Component = frmPrerequisites' + 'Status = stsDefault')) + end object dlgPrintReport: TPrintDialog Left = 113 Index: cprs/trunk/CPRS-Chart/Consults/fPreReq.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fPreReq.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/fPreReq.pas (revision 829) @@ -5,8 +5,9 @@ uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ORFn, ComCtrls, ExtCtrls; + StdCtrls, ORFn, ComCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager, + uReports; type - TfrmPrerequisites = class(TForm) + TfrmPrerequisites = class(TfrmBase508Form) lblFontTest: TLabel; memReport: TRichEdit; @@ -20,7 +21,7 @@ procedure cmdCancelClick(Sender: TObject); procedure cmdPrintClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure OnActivate(Sender: TObject); procedure FormCreate(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure FormShow(Sender: TObject); private procedure AlignButtons(); @@ -35,5 +36,5 @@ uses - uCore, rCore, rReports, Printers,rMisc; + uCore, rCore, rReports, Printers, rMisc; {$R *.DFM} @@ -66,6 +67,5 @@ ForceInsideWorkArea(Rect); BoundsRect := Rect; - memReport.Lines.Assign(ReportText); - ResizeAnchoredFormToFont(result); + QuickCopy(ReportText, memReport); //Quick fix to work around glich in resize algorithim AlignButtons(); @@ -127,5 +127,5 @@ AHeader := TStringList.Create; CreatePatientHeader(AHeader, Self.Caption); - memPrintReport := TRichEdit.Create(Self); + memPrintReport := CreateReportTextComponent(Self); try MaxLines := 60 - AHeader.Count; @@ -134,10 +134,4 @@ with memPrintReport do begin - Visible := False; - Parent := Self; - Font.Name := 'Courier New'; - Font.Size := MainFontSize; - Width := Printer.Canvas.TextWidth(StringOfChar('-', 74)); - //Width := 600; repeat with Lines do @@ -174,15 +168,9 @@ end; -procedure TfrmPrerequisites.FormCreate(Sender: TObject); -begin - memreport.Color := ReadOnlyColor; - -end; - procedure TfrmPrerequisites.AlignButtons; Const BtnSpace = 8; begin - cmdCancel.Left := self.Width - cmdCancel.Width - BtnSpace; + cmdCancel.Left := self.Width - cmdCancel.Width - (BtnSpace * 3) - 3; cmdContinue.Left := cmdCancel.Left - BtnSpace - cmdContinue.Width; end; @@ -194,8 +182,14 @@ end; -procedure TfrmPrerequisites.FormShow(Sender: TObject); +procedure TfrmPrerequisites.FormCreate(Sender: TObject); begin + inherited; + ResizeAnchoredFormToFont(Self); SetFormPosition(Self); //Get Saved Position & Size of Form end; +procedure TfrmPrerequisites.OnActivate(Sender: TObject); +begin + if Self.VertScrollBar.IsScrollBarVisible then Self.VertScrollBar.Position := 0; +end; end. Index: cprs/trunk/CPRS-Chart/Consults/rConsults.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/rConsults.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/rConsults.pas (revision 829) @@ -285,5 +285,5 @@ Results[i] := x; end; - Dest.Assign(Results); + FastAssign(Results, Dest); end else @@ -299,5 +299,5 @@ begin CallV('ORQQCN DETAIL', [IEN]); - Dest.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, Dest); end; @@ -306,5 +306,5 @@ begin CallV('ORQQCN MED RESULTS', [IEN]); - Dest.Assign(RPCBrokerV.Results); + FastAssign(RPCBrokerV.Results, Dest); end; @@ -327,5 +327,5 @@ alist := TStringList.Create ; try - alist.Assign(RPCBrokerV.Results) ; + FastAssign(RPCBrokerV.Results, aList); x := alist[0] ; if Piece(x,u,1) <> '-1' then @@ -459,5 +459,5 @@ begin CallV('ORQQCN RECEIVE', [IEN, ReceivedBy, RcptDate, Comments]); - Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'} + FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} end; @@ -466,5 +466,5 @@ begin CallV('ORQQCN2 SCHEDULE CONSULT', [IEN, ScheduledBy, SchdDate, Alert, AlertTo, Comments]); - Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'} + FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} end; @@ -473,5 +473,5 @@ begin CallV('ORQQCN DISCONTINUE', [IEN, DeniedBy, DenialDate,'DY',Comments]); - Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'} + FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} end; @@ -480,5 +480,5 @@ begin CallV('ORQQCN DISCONTINUE', [IEN, DiscontinuedBy, DiscontinueDate,'DC',Comments]); - Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'} + FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} end; @@ -486,6 +486,6 @@ ActionDate: TFMDateTime; Comments: TStrings); begin - CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]); - Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'} + CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]); + FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} end ; @@ -493,6 +493,6 @@ AlertTo: string) ; begin - CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]); - Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'} + CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]); + FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} end ; @@ -500,6 +500,6 @@ RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ; begin - CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]); - Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'} + CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]); + FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} end ; @@ -507,6 +507,6 @@ AlertTo: string) ; begin - CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]); - Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'} + CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]); + FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} end ; @@ -831,4 +831,5 @@ ClinProcDateTime := StrToFMDateTime(Piece(x, U, 4)); Title := StrToIntDef(Piece(x, U, 5), 0); + DateTime := StrToFloatDef(Piece(x, U, 6), 0); end; Result := AnEditRec; Index: cprs/trunk/CPRS-Chart/Consults/uConsults.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/uConsults.pas (revision 456) +++ cprs/trunk/CPRS-Chart/Consults/uConsults.pas (revision 829) @@ -38,4 +38,6 @@ ProvDxCode: string; { 30.1} RequestProcessingActivity: TStringList; { 40} + //EarliestDate: TFMDateTime; + //LatestDate: TFMDateTime; end ; @@ -51,4 +53,6 @@ Urgency: integer; UrgencyName: string; + //EarliestDate: TFMDateTime; + //LatestDate: TFMDateTime; Place: string; PlaceName: string; @@ -134,4 +138,5 @@ UL_ADMIN = 3; UL_UPDATE_AND_ADMIN = 4; + UL_UNRESTRICTED = 5; {Clinical Procedure statuses} @@ -297,5 +302,5 @@ SrcList := TStringList.Create; try - SrcList.Assign(Source); + FastAssign(Source, SrcList); with SrcList do begin