Index: cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm (revision 1679) @@ -4,5 +4,5 @@ BorderIcons = [] Caption = 'frmConsultAction' - ClientHeight = 379 + ClientHeight = 429 ClientWidth = 592 Constraints.MinHeight = 406 @@ -10,4 +10,6 @@ OldCreateOrder = True Position = poScreenCenter + ExplicitWidth = 600 + ExplicitHeight = 456 PixelsPerInch = 96 TextHeight = 13 @@ -16,16 +18,18 @@ Top = 0 Width = 592 - Height = 379 + Height = 429 Align = alClient BevelOuter = bvNone TabOrder = 0 + ExplicitHeight = 379 object pnlForward: TPanel Left = 0 Top = 0 Width = 224 - Height = 379 + Height = 429 Align = alLeft BevelOuter = bvNone TabOrder = 0 + ExplicitHeight = 379 object lblToService: TOROffsetLabel Left = 2 @@ -170,8 +174,9 @@ Top = 0 Width = 368 - Height = 379 + Height = 429 Align = alClient BevelOuter = bvNone TabOrder = 1 + ExplicitHeight = 379 object pnlSigFind: TPanel Left = 0 @@ -202,9 +207,10 @@ Top = 57 Width = 368 - Height = 224 + Height = 274 Align = alClient Alignment = taLeftJustify BevelOuter = bvNone TabOrder = 1 + ExplicitHeight = 224 object lblComments: TOROffsetLabel Left = 0 @@ -223,5 +229,5 @@ Top = 19 Width = 368 - Height = 170 + Height = 220 Align = alClient Font.Charset = ANSI_CHARSET @@ -234,8 +240,9 @@ TabOrder = 0 Caption = 'Comments' + ExplicitHeight = 170 end object pnlAlert: TPanel Left = 0 - Top = 189 + Top = 239 Width = 368 Height = 35 @@ -243,4 +250,5 @@ BevelOuter = bvNone TabOrder = 1 + ExplicitTop = 189 object lblAutoAlerts: TStaticText Left = 6 @@ -263,5 +271,5 @@ object pnlAllActions: TPanel Left = 0 - Top = 281 + Top = 331 Width = 368 Height = 98 @@ -269,4 +277,5 @@ BevelOuter = bvNone TabOrder = 2 + ExplicitTop = 281 DesignSize = ( 368 Index: cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas (revision 1679) @@ -153,4 +153,6 @@ i: integer; OrdItmIEN: integer; + attention: string; //wat cq 15561 + AList: TStringList; {WAT cq 19626} begin pnlSigFind.Visible := False; @@ -158,4 +160,6 @@ pnlComments.Visible := True; memComments.Clear; + AList := TStringList.Create; +try {WAT cq 19626} if IsProcedure then begin @@ -183,5 +187,7 @@ else begin - SortByPiece(TStringList(SvcList), U, 2); {RV} + FastAssign(SvcList, AList); {WAT cq 19626} + SortByPiece(AList, U, 2); {WAT cq 19626} + //SortByPiece(TStringList(SvcList), U, 2); {RV} for i := 0 to SvcList.Count - 1 do if (cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1) and {RV} @@ -200,9 +206,15 @@ end ; end; - pnlForward.Visible := True ; + pnlForward.Visible := True ; end ; if cboService.Items.Count = 1 then cboService.ItemIndex := 0; FToService := cboService.ItemIEN; - cboAttentionOf.InitLongList('') ; + //wat cq 15561 + //cboAttentionOf.InitLongList('') ; + FAttentionOf := ConsultRec.Attention; + attention := ExternalName(FAttentionOf,200); + cboAttentionOf.InitLongList(attention); + cboAttentionOf.SelectByIEN(FAttentionOf); + //end cq 15561 with cboUrgency do begin @@ -224,8 +236,11 @@ cboPerson.OnNeedData := NewPersonNeedData; // cboPerson.InitLongList(User.Name) ; - cboPerson.SelectByIEN(User.DUZ); + cboPerson.SelectByIEN(User.DUZ); ckAlert.Visible := False ; lblAutoAlerts.Visible := False; Result := True; +finally + AList.Free; {WAT cq 19626} +end; end; @@ -601,28 +616,28 @@ 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; + 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; Index: cprs/trunk/CPRS-Chart/Consults/fConsults.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsults.dfm (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fConsults.dfm (revision 1679) @@ -11,5 +11,5 @@ OnShow = FormShow ExplicitWidth = 723 - ExplicitHeight = 467 + ExplicitHeight = 475 PixelsPerInch = 96 TextHeight = 13 @@ -661,4 +661,9 @@ OnClick = cmdPCEClick end + object popNoteMemoViewCslt: TMenuItem + Caption = 'View Consult Details' + ShortCut = 24661 + OnClick = popNoteMemoViewCsltClick + end end object popConsultList: TPopupMenu Index: cprs/trunk/CPRS-Chart/Consults/fConsults.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fConsults.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fConsults.pas (revision 1679) @@ -180,4 +180,5 @@ imgLblImages: TVA508ImageListLabeler; imgLblConsults: TVA508ImageListLabeler; + popNoteMemoViewCslt: TMenuItem; //wat cq 17586 procedure mnuChartTabClick(Sender: TObject); procedure lstConsultsClick(Sender: TObject); @@ -285,4 +286,5 @@ procedure cmdEditResubmitExit(Sender: TObject); procedure cmdNewConsultExit(Sender: TObject); + procedure popNoteMemoViewCsltClick(Sender: TObject); //wat cq 17586 private FocusToRightPanel : Boolean; @@ -348,4 +350,6 @@ function UserIsSigner(NoteIEN: integer): boolean; public + function CustomCanFocus(Control: TWinControl): Boolean; //CB + function LinesVisible(richedit: Trichedit): integer; //CB function ActiveEditOf(AnIEN: Int64): Boolean; function AllowContextChange(var WhyNot: string): Boolean; override; @@ -364,4 +368,5 @@ property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published end; + var @@ -638,6 +643,7 @@ CurrNotifIEN := 0; EditingIndex := -1; - tvConsults.Enabled := True; - lstConsults.Enabled := True ; + pnlConsultList.Enabled := True; //CQ#15785 +// tvConsults.Enabled := True; +// lstConsults.Enabled := True ; lstNotes.Enabled := True ; pnlRead.BringToFront ; @@ -769,6 +775,7 @@ try ClearEditControls; - tvConsults.Enabled := False; - lstConsults.Enabled := False ; + pnlConsultList.Enabled := False; //CQ#15785 +// tvConsults.Enabled := False; +// lstConsults.Enabled := False ; FillChar(FEditNote, SizeOf(FEditNote), 0); //v15.7 with FEditNote do @@ -899,6 +906,7 @@ begin ClearEditControls; - lstConsults.Enabled := True; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True; +// tvConsults.Enabled := True; end; SetResultMenus ; @@ -930,6 +938,7 @@ AClassName := DCL_CONSULTS; ClearEditControls; - lstConsults.Enabled := False ; - tvConsults.Enabled := False; + pnlConsultList.Enabled := False; //CQ#15785 +// lstConsults.Enabled := False ; +// tvConsults.Enabled := False; with FEditNote do begin @@ -1008,6 +1017,7 @@ InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK); HaveRequired := False; - lstConsults.Enabled := True; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True; +// tvConsults.Enabled := True; end; {if CreatedNote.IEN} end; {if HaveRequired} @@ -1559,4 +1569,24 @@ end; +//wat cq 17586 +procedure TfrmConsults.popNoteMemoViewCsltClick(Sender: TObject); +var + CsltIEN: integer ; + ConsultDetail: TStringList; + x: string; +begin + inherited; + if (Screen.ActiveControl <> memResults) or (FEditNote.PkgPtr <> PKG_CONSULTS) then Exit; + CsltIEN := frmConsults.FEditNote.PkgIEN; + x := FindConsult(CsltIEN); + ConsultDetail := TStringList.Create; + try + LoadConsultDetail(ConsultDetail, CsltIEN) ; + ReportBox(ConsultDetail, 'Consult Details: #' + IntToStr(CsltIEN) + ' - ' + Piece(x, U, 4), TRUE); + finally + ConsultDetail.Free; + end; +end; //END cq 17586 + procedure TfrmConsults.mnuActAddIDEntryClick(Sender: TObject); const @@ -1792,6 +1822,7 @@ popNoteMemoEncounter.Visible := FALSE; UpdateList; - lstConsults.Enabled := True ; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True ; +// tvConsults.Enabled := True; with tvConsults do Selected := FindPieceNode(IntToStr(SaveConsult), 1, U, Items.GetFirstNode); tvConsultsClick(Self); @@ -1851,6 +1882,7 @@ pnlResults.Visible := False; pnlResults.SendToBack; - lstConsults.Enabled := True; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True; +// tvConsults.Enabled := True; if Notifications.Active then with tvConsults do @@ -1971,6 +2003,7 @@ pnlResults.Visible := False; pnlResults.SendToBack; - lstConsults.Enabled := True; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True; +// tvConsults.Enabled := True; if Notifications.Active then with tvConsults do @@ -2182,6 +2215,7 @@ ClearEditControls ; lstNotes.Enabled := False ; - lstConsults.Enabled := False ; - tvConsults.Enabled := False; + pnlConsultList.Enabled := False; //CQ#15785 +// lstConsults.Enabled := False ; +// tvConsults.Enabled := False; x := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 12); if x <> '' then @@ -2223,6 +2257,7 @@ //UnlockConsultRequest(lstNotes.ItemIEN, lstConsults.ItemIEN); lstNotes.Enabled := True ; - lstConsults.Enabled := True ; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True ; +// tvConsults.Enabled := True; end; @@ -2396,5 +2431,4 @@ (MenuAccessRec.UserLevel = UL_UNRESTRICTED)) and - (ConsultRec.ORStatus=ST_COMPLETE) and ((lstNotes.ItemIndex > -1) and ((ConsultRec.TIUResultNarrative>0) or @@ -2625,6 +2659,7 @@ if ItemIndex = EditingIndex then begin - lstConsults.Enabled := False ; - tvConsults.Enabled := False; + pnlConsultList.Enabled := False; //CQ#15785 +// lstConsults.Enabled := False ; +// tvConsults.Enabled := False; pnlResults.Visible := True; pnlResults.BringToFront; @@ -2639,6 +2674,7 @@ if EditingIndex = -1 then begin - lstConsults.Enabled := True ; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True ; +// tvConsults.Enabled := True; end; lblTitle.Caption := MakeConsultNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]); @@ -2710,4 +2746,5 @@ popNoteMemoPreview.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected); popNoteMemoInsTemplate.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected); + popNoteMemoViewCslt.Enabled := (FEditNote.PkgPtr = PKG_CONSULTS); //wat cq 17586 end else begin @@ -2718,4 +2755,5 @@ popNoteMemoPreview.Enabled := False; popNoteMemoInsTemplate.Enabled := False; + popNoteMemoViewCslt.Enabled := FALSE; //wat cq 17586 end; end; @@ -2838,5 +2876,4 @@ end; -{for printing multiple notes} procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList); var @@ -2844,13 +2881,20 @@ i: integer; begin + inherited; with AForm.lbIDParents do - 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; + begin + for i := 0 to Items.Count - 1 do + begin + if Selected[i] then + begin + NoteIEN := ItemIEN; //StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0); + if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) else + begin + if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK); + if NoteIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK); + end; + end; {if selected} + end; {for} + end; {with} end; @@ -3104,4 +3148,8 @@ AnObject: PDocTreeObject; tmpNode: TORTreeNode; + I:Integer; + CommentDate: String; + Format: CHARFORMAT2; + VisibleLineCount: integer; begin if EditingIndex <> -1 then @@ -3116,6 +3164,7 @@ tvConsults.Caption := Notifications.Text; EditingIndex := -1; - lstConsults.Enabled := True ; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True ; +// tvConsults.Enabled := True; lstNotes.Enabled := True ; pnlRead.BringToFront ; @@ -3204,7 +3253,38 @@ tvCsltNotesChange(Self, tvCsltNotes.Selected); end - else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0) then + else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0) + and (Pos(UpperCase('Comment added'), UpperCase(Notifications.Text)) = 0) then //CB mnuActDisplayResultsClick(Self); - + + //CB + If (Notifications.HighLightSection <> '') and (Pos(UpperCase('Comment added'), UpperCase(Notifications.Text)) > 0) then begin + CommentDate := FormatDateTime('mm/dd/yy hh:mm', StrToDateTime(StringReplace(Notifications.HighLightSection, '@', ' ', [rfReplaceAll])) ); + for I := 0 to memConsult.Lines.Count - 1 do begin + If (Pos(CommentDate, memConsult.Lines.Strings[i]) > 0) and (Pos(UpperCase('ADDED COMMENT'), UpperCase(memConsult.Lines.Strings[i])) > 0) then begin + if CustomCanFocus(memconsult) then + memConsult.SetFocus; + memConsult.SelStart := memConsult.Perform(EM_LINEINDEX, i,0); + memConsult.SelLength := Length(memConsult.Lines.Strings[i]); + + //Set the background color + Format.cbSize := SizeOf(Format); + Format.dwMask := CFM_BACKCOLOR; + + Format.crBackColor := clRed; + memConsult.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format)); + //Get visible Line Couunt + VisibleLineCount := LinesVisible(memConsult); + + if (I + VisibleLineCount)>= memConsult.Lines.Count - 1 then + memConsult.SelStart := memConsult.Perform(EM_LINEINDEX, memConsult.Lines.Count - 1,0) + else memConsult.SelStart := memConsult.Perform(EM_LINEINDEX,I + VisibleLineCount - 1,0); + + memConsult.Perform($00B7, 0, 0); //EM_SETCARRET DEFINED WRONG in Richedit.pas + memConsult.SelLength := 0; + break; + end; + end; + end; + case Notifications.Followup of NF_CONSULT_REQUEST_RESOLUTION : Notifications.Delete; @@ -3221,4 +3301,51 @@ FNotifPending := False; end; + +// ***************************************************************** +// Delphi's Can Focus has a bug. +// Source: http://qc.embarcadero.com/wc/qcmain.aspx?d=11229 +// ***************************************************************** +function TfrmConsults.CustomCanFocus(Control: TWinControl): Boolean; +var + Form: TCustomForm; +begin + Result := False; + Form := GetParentForm(Self); + if Form <> nil then + begin + Control := Self; + repeat + if not (Control.Visible and Control.Enabled) then + Exit; + Control := Control.Parent; + until Control = nil; + Result := True; + end; +end; + + function TfrmConsults.LinesVisible(richedit: Trichedit): integer; + Var + OldFont : HFont; + Hand : THandle; + TM : TTextMetric; + Rect : TRect; + tempint : integer; + begin + Hand := GetDC(richedit.Handle); + try + OldFont := SelectObject(Hand, richedit.Font.Handle); + try + GetTextMetrics(Hand, TM); + richedit.Perform(EM_GETRECT, 0, longint(@Rect)); + tempint := (Rect.Bottom - Rect.Top) div + (TM.tmHeight + TM.tmExternalLeading); + finally + SelectObject(Hand, OldFont); + end; + finally + ReleaseDC(richedit.Handle, Hand); + end; + Result := tempint; + end; procedure TfrmConsults.mnuActEditResubmitClick(Sender: TObject); @@ -3948,6 +4075,7 @@ if not LockConsultRequest(AConsult) then Exit; lstNotes.Enabled := False ; - lstConsults.Enabled := False ; - tvConsults.Enabled := False; + pnlConsultList.Enabled := False; //CQ#15785 +// lstConsults.Enabled := False ; +// tvConsults.Enabled := False; if ActionType = 'ATTACH' then begin @@ -3980,6 +4108,7 @@ end; lstNotes.Enabled := True ; - lstConsults.Enabled := True ; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True ; +// tvConsults.Enabled := True; FOrderID := GetConsultOrderIEN(AConsult); UnlockOrderIfAble(FOrderID); @@ -4068,6 +4197,7 @@ cmdPCE.Visible := FALSE; popNoteMemoEncounter.Visible := FALSE; - lstConsults.Enabled := True ; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True ; +// tvConsults.Enabled := True; lstNotes.Enabled := True; lblTitle.Caption := ''; @@ -4435,6 +4565,7 @@ popNoteListExpandSelected.Enabled := Selected.HasChildren; popNoteListCollapseSelected.Enabled := Selected.HasChildren; - lstConsults.Enabled := True ; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True ; +// tvConsults.Enabled := True; lstNotes.Enabled := True; if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then @@ -4450,6 +4581,7 @@ cmdPCE.Visible := FALSE; popNoteMemoEncounter.Visible := FALSE; - lstConsults.Enabled := True ; - tvConsults.Enabled := True; + pnlConsultList.Enabled := True; //CQ#15785 +// lstConsults.Enabled := True ; +// tvConsults.Enabled := True; KillDocTreeObjects(tvCsltNotes); tvCsltNotes.Items.Clear; Index: cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm (revision 1679) @@ -1,119 +1,54 @@ inherited frmEditCslt: TfrmEditCslt Tag = 110 - Left = 409 - Top = 225 - Width = 599 - Height = 375 + Left = 461 + Top = 191 + Width = 576 + Height = 479 HorzScrollBar.Range = 561 VertScrollBar.Range = 340 Caption = 'Edit/Resubmit a Cancelled Consult' - Constraints.MinHeight = 371 - Constraints.MinWidth = 573 + Constraints.MinHeight = 467 + Constraints.MinWidth = 576 OldCreateOrder = True Position = poScreenCenter - ExplicitLeft = 409 - ExplicitTop = 225 - ExplicitWidth = 599 - ExplicitHeight = 375 + ExplicitWidth = 576 + ExplicitHeight = 479 DesignSize = ( - 591 - 341) + 568 + 448) PixelsPerInch = 96 TextHeight = 13 - object lblService: TLabel [0] - Left = 4 - Top = 4 - Width = 134 - Height = 13 - Caption = 'Consult to Service/Specialty' - end - object lblReason: TLabel [1] - Left = 4 - Top = 166 - Width = 90 - Height = 13 - Caption = 'Reason for Consult' - end - object lblComment: TLabel [2] - Left = 4 - Top = 105 - Width = 77 - Height = 13 - Caption = 'New Comments:' - end - object lblComments: TLabel [3] - Left = 4 - Top = 51 - Width = 89 - Height = 13 - Caption = 'Display Comments:' - end - object lblUrgency: TStaticText [4] - Left = 196 - Top = 4 - Width = 44 - Height = 17 - Caption = 'Urgency' - TabOrder = 16 - end - object lblPlace: TStaticText [5] - Left = 376 - Top = 41 - Width = 104 - Height = 17 - Caption = 'Place of Consultation' - TabOrder = 17 - end - object lblAttn: TStaticText [6] - Left = 376 - Top = 4 - Width = 46 - Height = 17 - Caption = 'Attention' - TabOrder = 18 - end - object lblProvDiag: TStaticText [7] - Left = 195 - Top = 82 - Width = 104 - Height = 17 - Caption = 'Provisional Diagnosis' - TabOrder = 19 - end - object lblInpOutp: TStaticText [8] - Left = 197 - Top = 47 - Width = 127 - Height = 17 - Caption = 'Patient will be seen as an:' - TabOrder = 20 - end - object memReason: TRichEdit [9] - Left = 4 - Top = 179 - Width = 589 - Height = 137 - Anchors = [akLeft, akTop, akRight, akBottom] + object pnlCombatVet: TPanel [0] + Left = 0 + Top = 0 + Width = 568 + Height = 25 + Align = alTop + BevelOuter = bvLowered Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 - Font.Name = 'Courier New' + Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False - PopupMenu = popReason - ScrollBars = ssBoth - TabOrder = 11 - WantTabs = True - OnChange = ControlChange - OnExit = memReasonExit - OnKeyDown = memCommentKeyDown - OnKeyPress = memCommentKeyPress - OnKeyUp = memCommentKeyUp - ExplicitHeight = 136 - end - object pnlMessage: TPanel [10] - Left = 16 - Top = 294 - Width = 418 + TabOrder = 0 + object txtCombatVet: TVA508StaticText + Name = 'txtCombatVet' + Left = 1 + Top = 1 + Width = 566 + Height = 23 + Align = alClient + Alignment = taCenter + BevelOuter = bvNone + Enabled = False + TabOrder = 0 + ShowAccelChar = True + end + end + object pnlMessage: TPanel [1] + Left = 21 + Top = 404 + Width = 388 Height = 44 Anchors = [akLeft, akRight, akBottom] @@ -121,5 +56,5 @@ BorderStyle = bsSingle Caption = 'pnlMessage' - TabOrder = 15 + TabOrder = 4 Visible = False object imgMessage: TImage @@ -146,176 +81,17 @@ end end - object cboService: TORComboBox [11] - Left = 4 - Top = 19 - Width = 180 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Caption = 'Consult to Service/Specialty' - Color = clWindow - DropDownCount = 8 - Enabled = False - Font.Charset = DEFAULT_CHARSET - Font.Color = clGrayText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - ParentFont = False - Pieces = '2' - Sorted = True - SynonymChars = '<>' - TabOrder = 0 - CharsNeedMatch = 1 - end - object cboUrgency: TORComboBox [12] - Left = 196 - Top = 19 - Width = 170 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Caption = 'Urgency' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 1 - OnChange = ControlChange - CharsNeedMatch = 1 - end - object radInpatient: TRadioButton [13] - Left = 197 - Top = 61 - Width = 61 - Height = 17 - Caption = '&Inpatient' - TabOrder = 5 - OnClick = radInpatientClick - end - object radOutpatient: TRadioButton [14] - Left = 269 - Top = 61 - Width = 73 - Height = 17 - Caption = '&Outpatient' - TabOrder = 6 - OnClick = radOutpatientClick - end - object cboPlace: TORComboBox [15] - Left = 376 - Top = 54 - Width = 216 - Height = 21 - Anchors = [akLeft, akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Place of Consultation' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 7 - OnChange = ControlChange - CharsNeedMatch = 1 - end - object txtProvDiag: TCaptionEdit [16] - Left = 195 - Top = 95 - Width = 346 - Height = 21 - Anchors = [akLeft, akTop, akRight] - MaxLength = 180 - ParentShowHint = False - PopupMenu = mnuPopProvDx - ShowHint = True - TabOrder = 8 - OnChange = ControlChange - Caption = 'Provisional Diagnosis' - end - object txtAttn: TORComboBox [17] - Left = 376 - Top = 19 - Width = 218 - Height = 21 - Anchors = [akLeft, akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Attention' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = True - LookupPiece = 2 - MaxLength = 0 - Pieces = '2,3' - Sorted = False - SynonymChars = '<>' - TabOrder = 2 - OnChange = ControlChange - OnNeedData = txtAttnNeedData - CharsNeedMatch = 1 - end - object cboCategory: TORComboBox [18] - Left = 561 - Top = 103 - Width = 10 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = False - LongList = False - LookupPiece = 0 - MaxLength = 0 - Sorted = False - SynonymChars = '<>' - TabOrder = 14 - Visible = False - CharsNeedMatch = 1 - end - object cmdAccept: TButton [19] - Left = 437 - Top = 319 + object cmdAccept: TButton [2] + Left = 414 + Top = 425 Width = 72 Height = 21 Anchors = [akRight, akBottom] Caption = 'Resubmit' - TabOrder = 12 + TabOrder = 2 OnClick = cmdAcceptClick end - object cmdQuit: TButton [20] - Left = 514 - Top = 319 + object cmdQuit: TButton [3] + Left = 491 + Top = 425 Width = 72 Height = 21 @@ -323,52 +99,371 @@ Cancel = True Caption = 'Cancel' - TabOrder = 13 + TabOrder = 3 OnClick = cmdQuitClick end - object memComment: TRichEdit [21] - Left = 4 - Top = 121 - Width = 587 - Height = 41 - Anchors = [akLeft, akTop, akRight] - PopupMenu = popReason - TabOrder = 10 - WantTabs = True - OnChange = ControlChange - OnKeyDown = memCommentKeyDown - OnKeyPress = memCommentKeyPress - OnKeyUp = memCommentKeyUp - end - object btnCmtCancel: TButton [22] - Left = 110 - Top = 49 - Width = 75 - Height = 21 - Caption = 'Cancellation' - TabOrder = 3 - OnClick = btnCmtCancelClick - end - object btnCmtOther: TButton [23] - Left = 110 - Top = 75 - Width = 75 - Height = 21 - Caption = 'Other' - TabOrder = 4 - OnClick = btnCmtOtherClick - end - object cmdLexSearch: TButton [24] - Left = 545 - Top = 95 - Width = 46 - Height = 21 - Anchors = [akTop, akRight] - Caption = 'Lexicon' - TabOrder = 9 - OnClick = cmdLexSearchClick + object pnlMain: TPanel [4] + Left = 0 + Top = 0 + Width = 569 + Height = 402 + Anchors = [akLeft, akTop, akRight, akBottom] + BevelOuter = bvNone + TabOrder = 1 + DesignSize = ( + 569 + 402) + object lblService: TLabel + Left = 4 + Top = 4 + Width = 134 + Height = 13 + Caption = 'Consult to Service/Specialty' + end + object lblReason: TLabel + Left = 4 + Top = 227 + Width = 95 + Height = 13 + Caption = 'Reason for Request' + end + object lblComment: TLabel + Left = 4 + Top = 169 + Width = 77 + Height = 13 + Caption = 'New Comments:' + end + object lblComments: TLabel + Left = 8 + Top = 108 + Width = 89 + Height = 13 + Caption = 'Display Comments:' + end + object lblUrgency: TStaticText + Left = 196 + Top = 4 + Width = 44 + Height = 17 + Caption = 'Urgency' + TabOrder = 14 + end + object lblPlace: TStaticText + Left = 376 + Top = 93 + Width = 104 + Height = 17 + Caption = 'Place of Consultation' + TabOrder = 15 + end + object lblAttn: TStaticText + Left = 376 + Top = 4 + Width = 46 + Height = 17 + Caption = 'Attention' + TabOrder = 16 + end + object lblProvDiag: TStaticText + Left = 195 + Top = 134 + Width = 104 + Height = 17 + Caption = 'Provisional Diagnosis' + TabOrder = 17 + end + object lblInpOutp: TStaticText + Left = 197 + Top = 99 + Width = 127 + Height = 17 + Caption = 'Patient will be seen as an:' + TabOrder = 18 + end + object memReason: TRichEdit + Left = 4 + Top = 240 + Width = 559 + Height = 161 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + PopupMenu = popReason + ScrollBars = ssBoth + TabOrder = 12 + WantTabs = True + OnChange = ControlChange + OnExit = memReasonExit + OnKeyDown = memCommentKeyDown + OnKeyPress = memCommentKeyPress + OnKeyUp = memCommentKeyUp + end + object cboService: TORComboBox + Left = 4 + Top = 19 + Width = 180 + Height = 83 + Style = orcsSimple + AutoSelect = True + Caption = 'Consult to Service/Specialty' + Color = clWindow + DropDownCount = 8 + Enabled = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clGrayText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + ParentFont = False + Pieces = '2' + Sorted = True + SynonymChars = '<>' + TabOrder = 0 + CharsNeedMatch = 1 + end + object cboUrgency: TORComboBox + Left = 196 + Top = 19 + Width = 170 + Height = 21 + Style = orcsDropDown + AutoSelect = True + Caption = 'Urgency' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 1 + OnChange = ControlChange + CharsNeedMatch = 1 + end + object radInpatient: TRadioButton + Left = 197 + Top = 113 + Width = 61 + Height = 17 + Caption = '&Inpatient' + TabOrder = 6 + OnClick = radInpatientClick + end + object radOutpatient: TRadioButton + Left = 269 + Top = 113 + Width = 73 + Height = 17 + Caption = '&Outpatient' + TabOrder = 7 + OnClick = radOutpatientClick + end + object cboPlace: TORComboBox + Left = 376 + Top = 106 + Width = 188 + Height = 21 + Anchors = [akLeft, akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Place of Consultation' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 8 + OnChange = ControlChange + CharsNeedMatch = 1 + end + object txtProvDiag: TCaptionEdit + Left = 195 + Top = 147 + Width = 316 + Height = 21 + Anchors = [akLeft, akTop, akRight] + MaxLength = 180 + ParentShowHint = False + PopupMenu = mnuPopProvDx + ShowHint = True + TabOrder = 10 + OnChange = ControlChange + Caption = 'Provisional Diagnosis' + end + object txtAttn: TORComboBox + Left = 376 + Top = 19 + Width = 188 + Height = 21 + Anchors = [akLeft, akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Attention' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = True + LookupPiece = 2 + MaxLength = 0 + Pieces = '2,3' + Sorted = False + SynonymChars = '<>' + TabOrder = 2 + OnChange = ControlChange + OnNeedData = txtAttnNeedData + CharsNeedMatch = 1 + end + object cboCategory: TORComboBox + Left = 559 + Top = 103 + Width = 10 + Height = 21 + Style = orcsDropDown + AutoSelect = True + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = False + LongList = False + LookupPiece = 0 + MaxLength = 0 + Sorted = False + SynonymChars = '<>' + TabOrder = 13 + Visible = False + CharsNeedMatch = 1 + end + object memComment: TRichEdit + Left = 4 + Top = 185 + Width = 557 + Height = 41 + Anchors = [akLeft, akTop, akRight] + PopupMenu = popReason + TabOrder = 11 + WantTabs = True + OnChange = ControlChange + OnExit = memCommentExit + OnKeyDown = memCommentKeyDown + OnKeyPress = memCommentKeyPress + OnKeyUp = memCommentKeyUp + end + object btnCmtCancel: TButton + Left = 8 + Top = 127 + Width = 75 + Height = 21 + Caption = 'Cancellation' + TabOrder = 4 + OnClick = btnCmtCancelClick + end + object btnCmtOther: TButton + Left = 110 + Top = 127 + Width = 75 + Height = 21 + Caption = 'Other' + TabOrder = 5 + OnClick = btnCmtOtherClick + end + object cmdLexSearch: TButton + Left = 515 + Top = 147 + Width = 46 + Height = 21 + Anchors = [akTop, akRight] + Caption = 'Lexicon' + TabOrder = 9 + OnClick = cmdLexSearchClick + end + object lblEarliest: TStaticText + Left = 197 + Top = 46 + Width = 121 + Height = 17 + Caption = 'Earliest appropriate date:' + TabOrder = 19 + end + object calEarliest: TORDateBox + Left = 197 + Top = 62 + Width = 164 + Height = 21 + TabOrder = 3 + OnExit = calEarliestExit + DateOnly = True + RequireTime = False + end + object lblLatest: TStaticText + Left = 376 + Top = 46 + Width = 116 + Height = 17 + Caption = 'Latest appropriate date:' + TabOrder = 21 + Visible = False + end + object calLatest: TORDateBox + Left = 378 + Top = 62 + Width = 188 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 22 + Visible = False + OnExit = calLatestExit + DateOnly = True + RequireTime = False + end end inherited amgrMain: TVA508AccessibilityManager Data = ( ( + 'Component = pnlMessage' + 'Status = stsDefault') + ( + 'Component = memMessage' + 'Status = stsDefault') + ( + 'Component = cmdAccept' + 'Status = stsDefault') + ( + 'Component = cmdQuit' + 'Status = stsDefault') + ( + 'Component = frmEditCslt' + 'Status = stsDefault') + ( + 'Component = pnlMain' + 'Status = stsDefault') + ( 'Component = lblUrgency' 'Status = stsDefault') @@ -389,10 +484,4 @@ 'Status = stsDefault') ( - 'Component = pnlMessage' - 'Status = stsDefault') - ( - 'Component = memMessage' - 'Status = stsDefault') - ( 'Component = cboService' 'Status = stsDefault') @@ -419,10 +508,4 @@ 'Status = stsDefault') ( - 'Component = cmdAccept' - 'Status = stsDefault') - ( - 'Component = cmdQuit' - 'Status = stsDefault') - ( 'Component = memComment' 'Status = stsDefault') @@ -437,10 +520,25 @@ 'Status = stsDefault') ( - 'Component = frmEditCslt' + 'Component = lblEarliest' + 'Status = stsDefault') + ( + 'Component = calEarliest' + 'Status = stsDefault') + ( + 'Component = lblLatest' + 'Status = stsDefault') + ( + 'Component = calLatest' + 'Status = stsDefault') + ( + 'Component = pnlCombatVet' + 'Status = stsDefault') + ( + 'Component = txtCombatVet' 'Status = stsDefault')) end object mnuPopProvDx: TPopupMenu Left = 353 - Top = 77 + Top = 129 object mnuPopProvDxDelete: TMenuItem Caption = 'Delete diagnosis' @@ -450,6 +548,6 @@ object popReason: TPopupMenu OnPopup = popReasonPopup - Left = 411 - Top = 169 + Left = 523 + Top = 369 object popReasonCut: TMenuItem Caption = 'Cu&t' Index: cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas (revision 1679) @@ -6,8 +6,24 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons, - Menus, fBase508Form, VA508AccessibilityManager; + Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form; type - TfrmEditCslt = class(TfrmBase508Form) + TfrmEditCslt = class(TfrmAutoSz) + pnlMessage: TPanel; + imgMessage: TImage; + memMessage: TRichEdit; + cmdAccept: TButton; + cmdQuit: TButton; + pnlMain: TPanel; + lblService: TLabel; + lblReason: TLabel; + lblComment: TLabel; + lblComments: TLabel; + lblUrgency: TStaticText; + lblPlace: TStaticText; + lblAttn: TStaticText; + lblProvDiag: TStaticText; + lblInpOutp: TStaticText; + memReason: TRichEdit; cboService: TORComboBox; cboUrgency: TORComboBox; @@ -17,26 +33,15 @@ txtProvDiag: TCaptionEdit; txtAttn: TORComboBox; - lblReason: TLabel; - lblService: TLabel; - lblUrgency: TStaticText; - lblPlace: TStaticText; - lblAttn: TStaticText; - lblProvDiag: TStaticText; cboCategory: TORComboBox; - pnlMessage: TPanel; - imgMessage: TImage; - memMessage: TRichEdit; - cmdAccept: TButton; - cmdQuit: TButton; memComment: TRichEdit; - lblComment: TLabel; - lblComments: TLabel; btnCmtCancel: TButton; btnCmtOther: TButton; + cmdLexSearch: TButton; + lblEarliest: TStaticText; + calEarliest: TORDateBox; + lblLatest: TStaticText; + calLatest: TORDateBox; mnuPopProvDx: TPopupMenu; mnuPopProvDxDelete: TMenuItem; - cmdLexSearch: TButton; - lblInpOutp: TStaticText; - memReason: TRichEdit; popReason: TPopupMenu; popReasonCut: TMenuItem; @@ -45,4 +50,6 @@ popReasonPaste2: TMenuItem; popReasonReformat: TMenuItem; + pnlCombatVet: TPanel; + txtCombatVet: TVA508StaticText; procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); @@ -69,4 +76,7 @@ Shift: TShiftState); procedure memCommentKeyPress(Sender: TObject; var Key: Char); + procedure calEarliestExit(Sender: TObject); + procedure calLatestExit(Sender: TObject); + procedure memCommentExit(Sender: TObject); private FLastServiceID: string; @@ -75,5 +85,10 @@ FEditCtrl: TCustomEdit; FNavigatingTab: boolean; + FEarliestDate: TFMDateTime; + FProstheticsSvc: boolean; + //FLatestDate: TFMDateTime; procedure SetProvDiagPromptingMode; + procedure SetUpCombatVet; + procedure SetUpEarliestDate; protected procedure InitDialog; @@ -118,4 +133,6 @@ 'Another code must be selected'; TC_INACTIVE_CODE = 'Inactive ICD Code'; + TX_PAST_DATE = 'Earliest appropriate date must be today or later.'; + TX_BAD_DATES = 'Latest appropriate date must be equal to or later than earliest date.'; function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean; @@ -196,4 +213,12 @@ with cboUrgency do for i := 0 to Items.Count-1 do if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i; + SetUpEarliestDate; //wat v28 + if Not FProstheticsSvc then //wat v28 + begin + calEarliest.FMDateTime := OldRec.EarliestDate; + FEarliestDate := OldRec.EarliestDate; + //calLatest.FMDateTime := OldRec.LatestDate; + //FLatestDate := OldRec.LatestDate; + end; txtProvDiag.Text := OldRec.ProvDiagnosis; ProvDx.Code := OldRec.ProvDxCode; @@ -213,4 +238,13 @@ txtAttn.ItemIndex := -1; SetProvDiagPromptingMode; + if (patient.CombatVet.IsEligible = True) then + begin + SetUpCombatVet; + end + else + begin + txtCombatVet.Enabled := False; + pnlCombatVet.SendToBack; + end; FChanging := False; StatusText(''); @@ -247,4 +281,11 @@ if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then SetError(TX_INACTIVE_CODE); + if Not FProstheticsSvc then //wat v28 + begin + if calEarliest.FMDateTime < FMToday then SetError(TX_PAST_DATE); + //if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE); + //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES); + end; + end; @@ -317,4 +358,20 @@ UrgencyName := ''; end; + + if FEarliestDate > 0 then + begin + if FEarliestDate <> OldRec.EarliestDate then + EarliestDate := FEarliestDate + else + EarliestDate := 0; + end; + +(* if FLatestDate > 0 then + begin + if FLatestDate <> OldRec.LatestDate then + LatestDate := FLatestDate + else + LatestDate := 0; + end;*) with cboPlace do if Length(ItemID) > 0 then @@ -408,4 +465,18 @@ end; +procedure TfrmEditCslt.calEarliestExit(Sender: TObject); +begin + inherited; + FEarliestDate := calEarliest.FMDateTime; + ControlChange(Self); +end; + +procedure TfrmEditCslt.calLatestExit(Sender: TObject); +begin + inherited; + //FLatestDate := calLatest.FMDateTime; + //ControlChange(Self); +end; + procedure TfrmEditCslt.cmdAcceptClick(Sender: TObject); {Begin BillingAware} @@ -478,4 +549,16 @@ if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) and (ProvDx.PromptMode = 'L') then cmdLexSearchClick(Self); +end; + +procedure TfrmEditCslt.SetUpCombatVet; +begin + pnlCombatVet.BringToFront; + txtCombatVet.Enabled := True; + txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate; + pnlMain.Top := pnlMain.Top + pnlCombatVet.Height; + pnlMain.Anchors := [akLeft, akTop, akRight]; + self.Height := self.Height + pnlCombatVet.Height; + pnlMain.Anchors := [akLeft, akTop, akRight, akBottom]; + ActiveControl := txtCombatVet; end; @@ -655,4 +738,23 @@ end; +procedure TfrmEditCslt.memCommentExit(Sender: TObject); +//added OnExit code for CQ17822 WAT +var + AStringList: TStringList; +begin + inherited; + AStringList := TStringList.Create; + try + //QuickCopy(memComment, AStringList); + AStringList.Text := memComment.Text; + LimitStringLength(AStringList, 74); + //QuickCopy(AstringList, memComment); + memComment.Text := AStringList.Text; + ControlChange(Self); + finally + AStringList.Free; + end; +end; + procedure TfrmEditCslt.memCommentKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -671,3 +773,21 @@ end; +procedure TfrmEditCslt.SetUpEarliestDate; //wat v28 +begin + if IsProstheticsService(cboService.ItemIEN) = '1' then + begin + lblEarliest.Enabled := False; + calEarliest.Enabled := False; + calEarliest.Text := ''; + FProstheticsSvc := true; + end + else + begin + lblEarliest.Enabled := True; + calEarliest.Enabled := True; + calEarliest.Text := 'TODAY'; + FProstheticsSvc := false; + end; +end; + end. Index: cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm (revision 1679) @@ -1,138 +1,62 @@ inherited frmEditProc: TfrmEditProc Tag = 112 - Left = 296 - Top = 245 - Width = 571 - Height = 359 + Left = 408 + Top = 210 + Width = 580 + Height = 458 HorzScrollBar.Range = 561 VertScrollBar.Range = 308 Caption = 'Edit and resubmit a cancelled procedure' - Constraints.MinHeight = 359 - Constraints.MinWidth = 571 - OldCreateOrder = True + Constraints.MinHeight = 458 + Constraints.MinWidth = 580 Position = poScreenCenter - ExplicitLeft = 296 - ExplicitTop = 245 - ExplicitWidth = 571 - ExplicitHeight = 359 + ExplicitWidth = 580 + ExplicitHeight = 458 DesignSize = ( - 563 - 325) + 572 + 424) PixelsPerInch = 96 TextHeight = 13 - object lblProc: TLabel [0] - Left = 3 - Top = 7 - Width = 49 - Height = 13 - Caption = 'Procedure' - end - object lblReason: TLabel [1] - Left = 3 - Top = 167 - Width = 90 - Height = 13 - Caption = 'Reason for Consult' - end - object lblService: TOROffsetLabel [2] - Left = 3 - Top = 49 - Width = 158 - Height = 15 - Caption = 'Service to perform this procedure' - HorzOffset = 2 - Transparent = False - VertOffset = 2 - WordWrap = False - end - object lblComment: TLabel [3] - Left = 106 - Top = 109 - Width = 74 - Height = 13 - Caption = 'New Comments' - end - object lblComments: TLabel [4] - Left = 3 - Top = 99 - Width = 89 - Height = 13 - Caption = 'Display Comments:' - end - object lblUrgency: TStaticText [5] - Left = 190 - Top = 7 - Width = 44 - Height = 17 - Caption = 'Urgency' - TabOrder = 18 - end - object lblPlace: TStaticText [6] - Left = 362 - Top = 50 - Width = 104 - Height = 17 - Caption = 'Place of Consultation' - TabOrder = 19 - end - object lblAttn: TStaticText [7] - Left = 362 - Top = 7 - Width = 46 - Height = 17 - Caption = 'Attention' - TabOrder = 20 - end - object lblProvDiag: TStaticText [8] - Left = 190 - Top = 81 - Width = 104 - Height = 17 - Caption = 'Provisional Diagnosis' - TabOrder = 21 - end - object lblInpOutp: TStaticText [9] - Left = 192 - Top = 48 - Width = 127 - Height = 17 - Caption = 'Patient will be seen as an:' - TabOrder = 17 - end - object memReason: TRichEdit [10] - Left = 2 - Top = 181 - Width = 557 - Height = 119 - Anchors = [akLeft, akTop, akRight, akBottom] + object pnlCombatVet: TPanel [0] + Left = 0 + Top = 0 + Width = 572 + Height = 25 + Align = alTop + BevelOuter = bvLowered Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 - Font.Name = 'Courier New' + Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False - PopupMenu = popReason - ScrollBars = ssBoth - TabOrder = 12 - WantTabs = True - OnChange = ControlChange - OnExit = memReasonExit - OnKeyDown = memReasonKeyDown - OnKeyPress = memReasonKeyPress - OnKeyUp = memCommentKeyUp - end - object cmdAccept: TButton [11] - Left = 401 - Top = 303 + TabOrder = 0 + object txtCombatVet: TVA508StaticText + Name = 'txtCombatVet' + Left = 1 + Top = 1 + Width = 570 + Height = 23 + Align = alClient + Alignment = taCenter + BevelOuter = bvNone + Enabled = False + TabOrder = 0 + ShowAccelChar = True + end + end + object cmdAccept: TButton [1] + Left = 410 + Top = 400 Width = 72 Height = 21 Anchors = [akRight, akBottom] Caption = 'Resubmit' - TabOrder = 13 + TabOrder = 2 OnClick = cmdAcceptClick end - object cmdQuit: TButton [12] - Left = 486 - Top = 303 + object cmdQuit: TButton [2] + Left = 495 + Top = 400 Width = 72 Height = 21 @@ -140,218 +64,11 @@ Cancel = True Caption = 'Cancel' - TabOrder = 14 + TabOrder = 3 OnClick = cmdQuitClick end - object cboUrgency: TORComboBox [13] - Left = 190 - Top = 22 - Width = 165 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Caption = 'Urgency' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 2 - OnChange = ControlChange - CharsNeedMatch = 1 - end - object radInpatient: TRadioButton [14] - Left = 190 - Top = 61 - Width = 61 - Height = 17 - Caption = '&Inpatient' - TabOrder = 4 - OnClick = radInpatientClick - end - object radOutpatient: TRadioButton [15] - Left = 264 - Top = 61 - Width = 73 - Height = 17 - Caption = '&Outpatient' - TabOrder = 5 - OnClick = radOutpatientClick - end - object cboPlace: TORComboBox [16] - Left = 362 - Top = 63 - Width = 197 - Height = 21 - Anchors = [akLeft, akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Place of Consultation' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 6 - OnChange = ControlChange - CharsNeedMatch = 1 - ExplicitWidth = 195 - end - object txtProvDiag: TCaptionEdit [17] - Left = 190 - Top = 94 - Width = 315 - Height = 21 - Anchors = [akLeft, akTop, akRight] - MaxLength = 180 - ParentShowHint = False - PopupMenu = mnuPopProvDx - ShowHint = True - TabOrder = 7 - OnChange = ControlChange - Caption = 'Provisional Diagnosis' - end - object txtAttn: TORComboBox [18] - Left = 362 - Top = 22 - Width = 197 - Height = 21 - Anchors = [akLeft, akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Attention' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = True - LookupPiece = 2 - MaxLength = 0 - Pieces = '2,3' - Sorted = False - SynonymChars = '<>' - TabOrder = 3 - OnChange = ControlChange - OnNeedData = txtAttnNeedData - CharsNeedMatch = 1 - ExplicitWidth = 195 - end - object cboProc: TORComboBox [19] - Left = 3 - Top = 22 - Width = 173 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Caption = 'Procedure' - Color = clWindow - DropDownCount = 8 - Enabled = False - Font.Charset = DEFAULT_CHARSET - Font.Color = clGrayText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = True - LookupPiece = 0 - MaxLength = 0 - ParentFont = False - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 0 - OnChange = cboProcSelect - OnNeedData = cboProcNeedData - CharsNeedMatch = 1 - end - object cboCategory: TORComboBox [20] - Left = 505 - Top = -11 - Width = 2 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = False - LongList = False - LookupPiece = 0 - MaxLength = 0 - Sorted = False - SynonymChars = '<>' - TabOrder = 15 - Visible = False - OnChange = ControlChange - CharsNeedMatch = 1 - end - object cboService: TORComboBox [21] - Left = 3 - Top = 65 - Width = 173 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Caption = 'Service to perform this procedure' - Color = clWindow - DropDownCount = 8 - Enabled = False - Font.Charset = DEFAULT_CHARSET - Font.Color = clGrayText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = False - LongList = False - LookupPiece = 0 - MaxLength = 0 - ParentFont = False - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 1 - OnChange = ControlChange - CharsNeedMatch = 1 - end - object memComment: TRichEdit [22] - Left = 106 - Top = 123 - Width = 451 - Height = 38 - Anchors = [akLeft, akTop, akRight] - PopupMenu = popReason - TabOrder = 11 - WantTabs = True - OnChange = ControlChange - OnKeyUp = memCommentKeyUp - end - object pnlMessage: TPanel [23] - Left = 19 - Top = 276 - Width = 383 + object pnlMessage: TPanel [3] + Left = 12 + Top = 379 + Width = 392 Height = 44 Anchors = [akLeft, akRight, akBottom] @@ -359,5 +76,5 @@ BorderStyle = bsSingle Caption = 'pnlMessage' - TabOrder = 16 + TabOrder = 4 Visible = False object imgMessage: TImage @@ -384,35 +101,411 @@ end end - object btnCmtCancel: TButton [24] - Left = 11 - Top = 116 - Width = 75 - Height = 21 - Caption = 'Cancellation' - TabOrder = 9 - OnClick = btnCmtCancelClick - end - object btnCmtOther: TButton [25] - Left = 11 - Top = 139 - Width = 75 - Height = 21 - Caption = 'Other' - TabOrder = 10 - OnClick = btnCmtOtherClick - end - object cmdLexSearch: TButton [26] - Left = 509 - Top = 94 - Width = 49 - Height = 21 - Anchors = [akTop, akRight] - Caption = 'Lexicon' - TabOrder = 8 - OnClick = cmdLexSearchClick + object pnlMain: TPanel [4] + Left = 0 + Top = 0 + Width = 572 + Height = 393 + Anchors = [akLeft, akTop, akRight, akBottom] + BevelOuter = bvNone + TabOrder = 1 + DesignSize = ( + 572 + 393) + object lblProc: TLabel + Left = 3 + Top = 7 + Width = 49 + Height = 13 + Caption = 'Procedure' + end + object lblReason: TLabel + Left = 8 + Top = 225 + Width = 95 + Height = 13 + Caption = 'Reason for Request' + end + object lblService: TOROffsetLabel + Left = 3 + Top = 49 + Width = 158 + Height = 15 + Caption = 'Service to perform this procedure' + HorzOffset = 2 + Transparent = False + VertOffset = 2 + WordWrap = False + end + object lblComment: TLabel + Left = 8 + Top = 166 + Width = 74 + Height = 13 + Caption = 'New Comments' + end + object lblComments: TLabel + Left = 3 + Top = 92 + Width = 89 + Height = 13 + Caption = 'Display Comments:' + end + object lblUrgency: TStaticText + Left = 190 + Top = 7 + Width = 44 + Height = 17 + Caption = 'Urgency' + TabOrder = 17 + end + object lblPlace: TStaticText + Left = 360 + Top = 92 + Width = 104 + Height = 17 + Caption = 'Place of Consultation' + TabOrder = 18 + end + object lblAttn: TStaticText + Left = 362 + Top = 7 + Width = 46 + Height = 17 + Caption = 'Attention' + TabOrder = 19 + end + object lblProvDiag: TStaticText + Left = 188 + Top = 136 + Width = 104 + Height = 17 + Caption = 'Provisional Diagnosis' + TabOrder = 20 + end + object lblInpOutp: TStaticText + Left = 190 + Top = 92 + Width = 127 + Height = 17 + Caption = 'Patient will be seen as an:' + TabOrder = 16 + end + object memReason: TRichEdit + Left = 8 + Top = 241 + Width = 560 + Height = 151 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + PopupMenu = popReason + ScrollBars = ssBoth + TabOrder = 14 + WantTabs = True + OnChange = ControlChange + OnExit = memReasonExit + OnKeyDown = memReasonKeyDown + OnKeyPress = memReasonKeyPress + OnKeyUp = memCommentKeyUp + end + object cboUrgency: TORComboBox + Left = 190 + Top = 22 + Width = 165 + Height = 21 + Style = orcsDropDown + AutoSelect = True + Caption = 'Urgency' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 2 + OnChange = ControlChange + CharsNeedMatch = 1 + end + object radInpatient: TRadioButton + Left = 188 + Top = 105 + Width = 61 + Height = 17 + Caption = '&Inpatient' + TabOrder = 8 + OnClick = radInpatientClick + end + object radOutpatient: TRadioButton + Left = 255 + Top = 105 + Width = 73 + Height = 17 + Caption = '&Outpatient' + TabOrder = 9 + OnClick = radOutpatientClick + end + object cboPlace: TORComboBox + Left = 360 + Top = 107 + Width = 206 + Height = 21 + Anchors = [akLeft, akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Place of Consultation' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 10 + OnChange = ControlChange + CharsNeedMatch = 1 + end + object txtProvDiag: TCaptionEdit + Left = 188 + Top = 149 + Width = 324 + Height = 21 + Anchors = [akLeft, akTop, akRight] + MaxLength = 180 + ParentShowHint = False + PopupMenu = mnuPopProvDx + ShowHint = True + TabOrder = 12 + OnChange = ControlChange + Caption = 'Provisional Diagnosis' + end + object txtAttn: TORComboBox + Left = 362 + Top = 22 + Width = 206 + Height = 21 + Anchors = [akLeft, akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Attention' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = True + LookupPiece = 2 + MaxLength = 0 + Pieces = '2,3' + Sorted = False + SynonymChars = '<>' + TabOrder = 3 + OnChange = ControlChange + OnNeedData = txtAttnNeedData + CharsNeedMatch = 1 + end + object cboProc: TORComboBox + Left = 3 + Top = 22 + Width = 173 + Height = 21 + Style = orcsDropDown + AutoSelect = True + Caption = 'Procedure' + Color = clWindow + DropDownCount = 8 + Enabled = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clGrayText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = True + LookupPiece = 0 + MaxLength = 0 + ParentFont = False + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 0 + OnChange = cboProcSelect + OnNeedData = cboProcNeedData + CharsNeedMatch = 1 + end + object cboCategory: TORComboBox + Left = 505 + Top = -11 + Width = 2 + Height = 21 + Style = orcsDropDown + AutoSelect = True + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = False + LongList = False + LookupPiece = 0 + MaxLength = 0 + Sorted = False + SynonymChars = '<>' + TabOrder = 15 + Visible = False + OnChange = ControlChange + CharsNeedMatch = 1 + end + object cboService: TORComboBox + Left = 3 + Top = 65 + Width = 173 + Height = 21 + Style = orcsDropDown + AutoSelect = True + Caption = 'Service to perform this procedure' + Color = clWindow + DropDownCount = 8 + Enabled = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clGrayText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = False + LongList = False + LookupPiece = 0 + MaxLength = 0 + ParentFont = False + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 1 + OnChange = ControlChange + CharsNeedMatch = 1 + end + object memComment: TRichEdit + Left = 8 + Top = 180 + Width = 560 + Height = 38 + Anchors = [akLeft, akTop, akRight] + PopupMenu = popReason + TabOrder = 13 + WantTabs = True + OnChange = ControlChange + OnExit = memCommentExit + OnKeyUp = memCommentKeyUp + end + object btnCmtCancel: TButton + Left = 3 + Top = 111 + Width = 75 + Height = 21 + Caption = 'Cancellation' + TabOrder = 6 + OnClick = btnCmtCancelClick + end + object btnCmtOther: TButton + Left = 84 + Top = 111 + Width = 75 + Height = 21 + Caption = 'Other' + TabOrder = 7 + OnClick = btnCmtOtherClick + end + object cmdLexSearch: TButton + Left = 516 + Top = 149 + Width = 49 + Height = 21 + Anchors = [akTop, akRight] + Caption = 'Lexicon' + TabOrder = 11 + OnClick = cmdLexSearchClick + end + object lblEarliest: TStaticText + Left = 190 + Top = 49 + Width = 121 + Height = 17 + Caption = 'Earliest appropriate date:' + TabOrder = 21 + end + object lblLatest: TStaticText + Left = 361 + Top = 49 + Width = 116 + Height = 17 + Caption = 'Latest appropriate date:' + TabOrder = 22 + Visible = False + end + object calEarliest: TORDateBox + Left = 190 + Top = 65 + Width = 164 + Height = 21 + TabOrder = 4 + OnExit = calEarliestExit + DateOnly = True + RequireTime = False + end + object calLatest: TORDateBox + Left = 362 + Top = 65 + Width = 204 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 5 + Visible = False + OnExit = calLatestExit + DateOnly = True + RequireTime = False + end end inherited amgrMain: TVA508AccessibilityManager Data = ( ( + 'Component = cmdAccept' + 'Status = stsDefault') + ( + 'Component = cmdQuit' + 'Status = stsDefault') + ( + 'Component = pnlMessage' + 'Status = stsDefault') + ( + 'Component = memMessage' + 'Status = stsDefault') + ( + 'Component = frmEditProc' + 'Status = stsDefault') + ( + 'Component = pnlMain' + 'Status = stsDefault') + ( 'Component = lblUrgency' 'Status = stsDefault') @@ -433,10 +526,4 @@ 'Status = stsDefault') ( - 'Component = cmdAccept' - 'Status = stsDefault') - ( - 'Component = cmdQuit' - 'Status = stsDefault') - ( 'Component = cboUrgency' 'Status = stsDefault') @@ -469,10 +556,4 @@ 'Status = stsDefault') ( - 'Component = pnlMessage' - 'Status = stsDefault') - ( - 'Component = memMessage' - 'Status = stsDefault') - ( 'Component = btnCmtCancel' 'Status = stsDefault') @@ -484,10 +565,25 @@ 'Status = stsDefault') ( - 'Component = frmEditProc' + 'Component = lblEarliest' + 'Status = stsDefault') + ( + 'Component = lblLatest' + 'Status = stsDefault') + ( + 'Component = calEarliest' + 'Status = stsDefault') + ( + 'Component = calLatest' + 'Status = stsDefault') + ( + 'Component = pnlCombatVet' + 'Status = stsDefault') + ( + 'Component = txtCombatVet' 'Status = stsDefault')) end object mnuPopProvDx: TPopupMenu - Left = 353 - Top = 77 + Left = 351 + Top = 132 object mnuPopProvDxDelete: TMenuItem Caption = 'Delete diagnosis' @@ -497,6 +593,6 @@ object popReason: TPopupMenu OnPopup = popReasonPopup - Left = 411 - Top = 169 + Left = 539 + Top = 361 object popReasonCut: TMenuItem Caption = 'Cu&t' Index: cprs/trunk/CPRS-Chart/Consults/fEditProc.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fEditProc.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fEditProc.pas (revision 1679) @@ -6,10 +6,25 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons, - Menus, fBase508Form, VA508AccessibilityManager; + Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form; type - TfrmEditProc = class(TfrmBase508Form) + TfrmEditProc = class(TfrmAutoSz) cmdAccept: TButton; cmdQuit: TButton; + pnlMessage: TPanel; + imgMessage: TImage; + memMessage: TRichEdit; + pnlMain: TPanel; + lblProc: TLabel; + lblReason: TLabel; + lblService: TOROffsetLabel; + lblComment: TLabel; + lblComments: TLabel; + lblUrgency: TStaticText; + lblPlace: TStaticText; + lblAttn: TStaticText; + lblProvDiag: TStaticText; + lblInpOutp: TStaticText; + memReason: TRichEdit; cboUrgency: TORComboBox; radInpatient: TRadioButton; @@ -18,27 +33,17 @@ txtProvDiag: TCaptionEdit; txtAttn: TORComboBox; - lblProc: TLabel; cboProc: TORComboBox; - lblReason: TLabel; - lblUrgency: TStaticText; - lblPlace: TStaticText; - lblAttn: TStaticText; - lblProvDiag: TStaticText; cboCategory: TORComboBox; cboService: TORComboBox; - lblService: TOROffsetLabel; memComment: TRichEdit; - lblComment: TLabel; - lblComments: TLabel; - pnlMessage: TPanel; - imgMessage: TImage; - memMessage: TRichEdit; btnCmtCancel: TButton; btnCmtOther: TButton; + cmdLexSearch: TButton; + lblEarliest: TStaticText; + lblLatest: TStaticText; + calEarliest: TORDateBox; + calLatest: TORDateBox; mnuPopProvDx: TPopupMenu; mnuPopProvDxDelete: TMenuItem; - cmdLexSearch: TButton; - lblInpOutp: TStaticText; - memReason: TRichEdit; popReason: TPopupMenu; popReasonCut: TMenuItem; @@ -47,4 +52,6 @@ popReasonPaste2: TMenuItem; popReasonReformat: TMenuItem; + pnlCombatVet: TPanel; + txtCombatVet: TVA508StaticText; procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); @@ -74,4 +81,7 @@ Shift: TShiftState); procedure memReasonKeyPress(Sender: TObject; var Key: Char); + procedure calEarliestExit(Sender: TObject); + procedure calLatestExit(Sender: TObject); + procedure memCommentExit(Sender: TObject); private FLastProcID: string; @@ -80,5 +90,8 @@ FEditCtrl: TCustomEdit; FNavigatingTab: boolean; + FEarliestDate: TFMDateTime; + //FLatestDate: TFMDateTime; procedure SetProvDiagPromptingMode; + procedure SetUpCombatVet; protected procedure InitDialog; @@ -117,4 +130,6 @@ 'Another code must be selected'; TC_INACTIVE_CODE = 'Inactive ICD Code'; + TX_PAST_DATE = 'Earliest appropriate date must be today or later.'; + TX_BAD_DATES = 'Latest appropriate date must be equal to or later than earliest date.'; function EditResubmitProcedure(FontSize: Integer; ConsultIEN: integer): boolean; @@ -165,4 +180,5 @@ i: integer; begin + if FChanging then exit; FChanging := True; Defaults := TStringList.Create; @@ -199,4 +215,8 @@ with cboUrgency do for i := 0 to Items.Count-1 do if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i; + calEarliest.FMDateTime := OldRec.EarliestDate; + FEarliestDate := OldRec.EarliestDate; + //calLatest.FMDateTime := OldRec.LatestDate; + //FLatestDate := OldRec.LatestDate; txtProvDiag.Text := OldRec.ProvDiagnosis; ProvDx.Code := OldRec.ProvDxCode; @@ -211,4 +231,13 @@ memComment.Clear ; SetProvDiagPromptingMode; + if (patient.CombatVet.IsEligible = True) then + begin + SetUpCombatVet; + end + else + begin + txtCombatVet.Enabled := False; + pnlCombatVet.SendToBack; + end; FChanging := False; StatusText(''); @@ -238,4 +267,7 @@ if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then SetError(TX_INACTIVE_CODE); + if calEarliest.FMDateTime < FMToday then SetError(TX_PAST_DATE); + //if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE); + //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES); end; @@ -245,4 +277,18 @@ inherited; txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction)); +end; + +procedure TfrmEditProc.calEarliestExit(Sender: TObject); +begin + inherited; + FEarliestDate := calEarliest.FMDateTime; + ControlChange(Self); +end; + +procedure TfrmEditProc.calLatestExit(Sender: TObject); +begin + inherited; + //FLatestDate := calLatest.FMDateTime; + //ControlChange(Self); end; @@ -323,4 +369,19 @@ end; + if FEarliestDate > 0 then + begin + if FEarliestDate <> OldRec.EarliestDate then + EarliestDate := FEarliestDate + else + EarliestDate := 0; + end; + +(* if FLatestDate > 0 then + begin + if FLatestDate <> OldRec.LatestDate then + LatestDate := FLatestDate + else + LatestDate := 0; + end;*) with cboPlace do if Length(ItemID) > 0 then @@ -433,4 +494,16 @@ end; +procedure TfrmEditProc.SetUpCombatVet; +begin + pnlCombatVet.BringToFront; + txtCombatVet.Enabled := True; + txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate; + pnlMain.Top := pnlMain.Top + pnlCombatVet.Height; + pnlMain.Anchors := [akLeft, akTop, akRight]; + self.Height := self.Height + pnlCombatVet.Height; + pnlMain.Anchors := [akLeft, akTop, akRight, akBottom]; + ActiveControl := txtCombatVet; +end; + procedure TfrmEditProc.cboProcSelect(Sender: TObject); begin @@ -454,5 +527,5 @@ InfoBox('There are no services defined for this procedure.', 'Information', MB_OK or MB_ICONINFORMATION); - cboProc.ItemIndex := -1; + //cboProc.ItemIndex := -1; InitDialog; Exit ; @@ -652,4 +725,23 @@ +procedure TfrmEditProc.memCommentExit(Sender: TObject); +//added OnExit code for CQ17822 WAT +var + AStringList: TStringList; +begin + inherited; + AStringList := TStringList.Create; + try + //QuickCopy(memComment, AStringList); + AStringList.Text := memComment.Text; + LimitStringLength(AStringList, 74); + //QuickCopy(AstringList, memComment); + memComment.Text := AStringList.Text; + ControlChange(Self); + finally + AStringList.Free; + end; +end; + procedure TfrmEditProc.memCommentKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -671,5 +763,5 @@ Shift: TShiftState); begin - //The navigating tab controls were inadvertantently adding tab characters + //The navigating tab controls were inadvertently adding tab characters //This should fix it FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []); Index: cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm (revision 1679) @@ -4,101 +4,48 @@ Top = 203 Width = 606 - Height = 376 + Height = 455 HorzScrollBar.Range = 590 VertScrollBar.Range = 340 Caption = 'Order a Consult' - Constraints.MinHeight = 376 - Constraints.MinWidth = 606 + Constraints.MinHeight = 442 + Constraints.MinWidth = 590 Font.Charset = ANSI_CHARSET ExplicitWidth = 606 - ExplicitHeight = 376 + ExplicitHeight = 455 PixelsPerInch = 96 TextHeight = 13 - object lblService: TLabel [0] - Left = 1 - Top = 2 - Width = 134 - Height = 13 - Caption = 'Consult to Service/Specialty' - end - 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 = 128 - Width = 585 - Height = 161 - Anchors = [akLeft, akTop, akRight] - BevelOuter = bvNone - TabOrder = 10 - object lblReason: TLabel - Left = 0 - Top = 0 - Width = 585 - Height = 13 - Align = alTop - Caption = 'Reason for Request' - ExplicitWidth = 95 - end - object memReason: TRichEdit - Left = 0 - Top = 13 - Width = 585 - Height = 148 + object pnlCombatVet: TPanel [0] + Left = 0 + Top = 0 + Width = 598 + Height = 25 + Align = alTop + BevelOuter = bvLowered + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 0 + object txtCombatVet: TVA508StaticText + Name = 'txtCombatVet' + Left = 1 + Top = 1 + Width = 596 + Height = 23 Align = alClient - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Courier New' - Font.Style = [] - Constraints.MinHeight = 40 - ParentFont = False - PopupMenu = popReason - ScrollBars = ssBoth + Alignment = taCenter + BevelOuter = bvNone + Enabled = False TabOrder = 0 - WantTabs = True - OnChange = ControlChange - OnExit = memReasonExit - OnKeyDown = memReasonKeyDown - OnKeyPress = memReasonKeyPress - OnKeyUp = memReasonKeyUp + ShowAccelChar = True end end inherited memOrder: TCaptionMemo Left = 3 - Top = 305 + Top = 384 Width = 417 Height = 41 - TabStop = True Anchors = [akLeft, akBottom] Lines.Strings = ( @@ -107,324 +54,475 @@ '--------------------------------' 'An order message may be displayed here.') - TabOrder = 11 + TabOrder = 2 ExplicitLeft = 3 - ExplicitTop = 305 + ExplicitTop = 384 ExplicitWidth = 417 ExplicitHeight = 41 end - object cboService: TORComboBox [7] + object pnlMain: TPanel [2] Left = 0 - Top = 16 - Width = 274 - Height = 113 - Anchors = [akLeft, akTop, akRight] - Style = orcsSimple - AutoSelect = True - Caption = 'Consult to Service/Specialty' - Color = clWindow - DropDownCount = 12 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 0 - TabStop = True - OnChange = ControlChange - OnClick = cboServiceSelect - OnExit = cboServiceExit - OnKeyDown = cboServiceKeyDown - OnKeyUp = cboServiceKeyUp - CharsNeedMatch = 1 - end - object cboUrgency: TORComboBox [8] - Left = 309 - Top = 16 - Width = 133 - Height = 21 - Anchors = [akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' + Top = 0 + Width = 598 + Height = 380 + Anchors = [akLeft, akTop, akRight, akBottom] + BevelOuter = bvNone + TabOrder = 1 + DesignSize = ( + 598 + 380) + object lblService: TLabel + Left = 1 + Top = 2 + Width = 134 + Height = 13 + Caption = 'Consult to Service/Specialty' + end + object lblProvDiag: TLabel + Left = 312 + Top = 138 + Width = 100 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Provisional Diagnosis' + end + object lblUrgency: TLabel + Left = 309 + Top = 2 + Width = 40 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Urgency' + end + object lblPlace: TLabel + Left = 457 + Top = 100 + Width = 100 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Place of Consultation' + end + object lblAttn: TLabel + Left = 454 + Top = 2 + Width = 42 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Attention' + end + object lblLatest: TStaticText + Left = 454 + Top = 43 + Width = 116 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Latest appropriate date:' + TabOrder = 17 + Visible = False + end + object lblEarliest: TStaticText + Left = 309 + Top = 43 + Width = 121 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Earliest appropriate date:' + TabOrder = 14 + end + object pnlReason: TPanel + Left = 3 + Top = 176 + Width = 587 + Height = 179 + Anchors = [akLeft, akTop, akRight] + BevelOuter = bvNone + Constraints.MinHeight = 53 + TabOrder = 13 + object lblReason: TLabel + Left = 0 + Top = 0 + Width = 587 + Height = 13 + Align = alTop + Caption = 'Reason for Request' + Constraints.MinHeight = 13 + ExplicitWidth = 95 + end + object memReason: TRichEdit + Left = 0 + Top = 13 + Width = 587 + Height = 166 + Align = alClient + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + Constraints.MinHeight = 40 + MaxLength = 2147483645 + ParentFont = False + PopupMenu = popReason + ScrollBars = ssBoth + TabOrder = 0 + WantTabs = True + OnChange = ControlChange + OnExit = memReasonExit + OnKeyDown = memReasonKeyDown + OnKeyPress = memReasonKeyPress + OnKeyUp = memReasonKeyUp + end + end + object cboService: TORComboBox + Left = 0 + Top = 16 + Width = 274 + Height = 154 + Anchors = [akLeft, akTop, akRight] + Style = orcsSimple + AutoSelect = True + Caption = 'Consult to Service/Specialty' + Color = clWindow + DropDownCount = 16 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 0 + OnChange = ControlChange + OnClick = cboServiceSelect + OnExit = cboServiceExit + OnKeyDown = cboServiceKeyDown + OnKeyUp = cboServiceKeyUp + CharsNeedMatch = 1 + end + object cboUrgency: TORComboBox + Left = 309 + Top = 16 + Width = 133 + Height = 21 + Anchors = [akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Urgency' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 4 + TabStop = True + OnChange = ControlChange + CharsNeedMatch = 1 + end + object cboPlace: TORComboBox + Left = 457 + Top = 113 + Width = 136 + Height = 21 + Anchors = [akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Place of Consultation' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 9 + OnChange = ControlChange + CharsNeedMatch = 1 + end + object txtProvDiag: TCaptionEdit + Left = 312 + Top = 151 + Width = 223 + Height = 21 + Anchors = [akTop, akRight] + MaxLength = 180 + ParentShowHint = False + PopupMenu = mnuPopProvDx + ShowHint = True + TabOrder = 11 + OnChange = txtProvDiagChange + Caption = 'Provisional Diagnosis' + end + object txtAttn: TORComboBox + Left = 454 + Top = 16 + Width = 136 + Height = 21 + Anchors = [akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Attention' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = True + LookupPiece = 2 + MaxLength = 0 + Pieces = '2,3' + Sorted = False + SynonymChars = '<>' + TabOrder = 5 + OnChange = ControlChange + OnNeedData = txtAttnNeedData + CharsNeedMatch = 1 + end + object treService: TORTreeView + Left = 0 + Top = 38 + Width = 298 + Height = 220 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -9 + Font.Name = 'MS Sans Serif' + Font.Style = [] + HideSelection = False + Indent = 19 + ParentFont = False + ReadOnly = True + TabOrder = 3 + 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 + Left = 225 + Top = -5 + Width = 5 + Height = 21 + Style = orcsDropDown + AutoSelect = True + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = False + LongList = False + LookupPiece = 0 + MaxLength = 0 + Sorted = False + SynonymChars = '<>' + TabOrder = 18 + Visible = False + CharsNeedMatch = 1 + end + object pnlServiceTreeButton: TKeyClickPanel + Left = 274 + Top = 14 + Width = 26 + Height = 26 + Hint = 'View services/specialties hierarchically' + Anchors = [akTop, akRight] + BevelOuter = bvNone + BevelWidth = 2 + Caption = 'View services/specialties hierarchically' + Font.Charset = ANSI_CHARSET + Font.Color = clBtnFace + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 2 + TabStop = True + OnClick = btnServiceTreeClick + OnEnter = pnlServiceTreeButtonEnter + OnExit = pnlServiceTreeButtonExit + object btnServiceTree: TSpeedButton + Left = 2 + Top = 2 + Width = 22 + Height = 22 + Glyph.Data = { + 26050000424D26050000000000003604000028000000100000000F0000000100 + 080000000000F000000000000000000000000001000000010000000000000000 + 80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA + A6000020400000206000002080000020A0000020C0000020E000004000000040 + 20000040400000406000004080000040A0000040C0000040E000006000000060 + 20000060400000606000006080000060A0000060C0000060E000008000000080 + 20000080400000806000008080000080A0000080C0000080E00000A0000000A0 + 200000A0400000A0600000A0800000A0A00000A0C00000A0E00000C0000000C0 + 200000C0400000C0600000C0800000C0A00000C0C00000C0E00000E0000000E0 + 200000E0400000E0600000E0800000E0A00000E0C00000E0E000400000004000 + 20004000400040006000400080004000A0004000C0004000E000402000004020 + 20004020400040206000402080004020A0004020C0004020E000404000004040 + 20004040400040406000404080004040A0004040C0004040E000406000004060 + 20004060400040606000406080004060A0004060C0004060E000408000004080 + 20004080400040806000408080004080A0004080C0004080E00040A0000040A0 + 200040A0400040A0600040A0800040A0A00040A0C00040A0E00040C0000040C0 + 200040C0400040C0600040C0800040C0A00040C0C00040C0E00040E0000040E0 + 200040E0400040E0600040E0800040E0A00040E0C00040E0E000800000008000 + 20008000400080006000800080008000A0008000C0008000E000802000008020 + 20008020400080206000802080008020A0008020C0008020E000804000008040 + 20008040400080406000804080008040A0008040C0008040E000806000008060 + 20008060400080606000806080008060A0008060C0008060E000808000008080 + 20008080400080806000808080008080A0008080C0008080E00080A0000080A0 + 200080A0400080A0600080A0800080A0A00080A0C00080A0E00080C0000080C0 + 200080C0400080C0600080C0800080C0A00080C0C00080C0E00080E0000080E0 + 200080E0400080E0600080E0800080E0A00080E0C00080E0E000C0000000C000 + 2000C0004000C0006000C0008000C000A000C000C000C000E000C0200000C020 + 2000C0204000C0206000C0208000C020A000C020C000C020E000C0400000C040 + 2000C0404000C0406000C0408000C040A000C040C000C040E000C0600000C060 + 2000C0604000C0606000C0608000C060A000C060C000C060E000C0800000C080 + 2000C0804000C0806000C0808000C080A000C080C000C080E000C0A00000C0A0 + 2000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0E000C0C00000C0C0 + 2000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0A000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFF0700 + 07FFFFFFFFFFFFFFFFFFFFA4A407000400FF040404040404FFFFFFA4FFFF0700 + 07FFFFFFFFFFFFFFFFFFFFA4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA4FFFFFFFF + FFFF070007FFFFFFFFFFFFA4FFFFFFA4A407000400FF04040404FFA4FFFFFFA4 + FFFF070007FFFFFFFFFFFFA4FFFFFF07FFFFFFFFFFFFFFFFFFFFFFA4FFFF0700 + 07FFFFFFFFFFFFFFFFFFFFA4A407000400FF0404040404FFFFFFFFA4FFFF0700 + 07FFFFFFFFFFFFFFFFFFFF07FFFFFFFFFFFFFFFFFFFFFFFFFFFF070007FFFFFF + FFFFFFFFFFFFFFFFFFFF00FB00FF0404040404FFFFFFFFFFFFFF070007FFFFFF + FFFFFFFFFFFFFFFFFFFF} + Margin = 0 + OnClick = btnServiceTreeClick + end + end + object gbInptOpt: TGroupBox + Left = 309 + Top = 92 + Width = 140 + Height = 45 + Anchors = [akTop, akRight] + Caption = 'Patient will be seen as an:' + TabOrder = 8 + object radInpatient: TRadioButton + Left = 3 + Top = 20 + Width = 61 + Height = 13 + Caption = '&Inpatient' + TabOrder = 1 + OnClick = radInpatientClick + end + object radOutpatient: TRadioButton + Left = 67 + Top = 20 + Width = 70 + Height = 13 + Caption = '&Outpatient' + TabOrder = 0 + OnClick = radOutpatientClick + end + end + object btnDiagnosis: TButton + Left = 541 + Top = 151 + Width = 49 + Height = 21 + Anchors = [akTop, akRight] + Caption = 'Diagnosis' + TabOrder = 10 + OnClick = btnDiagnosisClick + end + object cmdLexSearch: TButton + Left = 541 + Top = 151 + Width = 49 + Height = 21 + Anchors = [akTop, akRight] + Caption = 'Lexicon' + TabOrder = 12 + OnClick = cmdLexSearchClick + end + object calEarliest: TORDateBox + Left = 309 + Top = 57 + Width = 133 + Height = 21 + Anchors = [akTop, akRight] + TabOrder = 6 + OnChange = ControlChange + DateOnly = True + RequireTime = False + end + object calLatest: TORDateBox + Left = 454 + Top = 57 + Width = 136 + Height = 21 + Anchors = [akTop, akRight] + TabOrder = 7 + Visible = False + OnChange = ControlChange + DateOnly = True + RequireTime = False + end + object servicelbl508: TVA508StaticText + Name = 'servicelbl508' + Left = 151 + Top = 1 + Width = 106 + Height = 15 + Alignment = taLeftJustify + Caption = 'service (for screen R.)' + Enabled = False + TabOrder = 1 + Visible = False + ShowAccelChar = True + end + end + inherited cmdAccept: TButton + Left = 427 + Top = 394 + Anchors = [akLeft, akBottom] TabOrder = 3 - TabStop = True - OnChange = ControlChange - CharsNeedMatch = 1 - end - object cboPlace: TORComboBox [9] - Left = 454 - Top = 56 - Width = 136 - Height = 21 - Anchors = [akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 6 - OnChange = ControlChange - CharsNeedMatch = 1 - end - object txtProvDiag: TCaptionEdit [10] - Left = 309 - Top = 94 - Width = 231 - Height = 21 - Anchors = [akTop, akRight] - MaxLength = 180 - ParentShowHint = False - PopupMenu = mnuPopProvDx - ShowHint = True - TabOrder = 8 - OnChange = txtProvDiagChange - end - object txtAttn: TORComboBox [11] - Left = 454 - Top = 16 - Width = 136 - Height = 21 - Anchors = [akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = True - LookupPiece = 2 - MaxLength = 0 - Pieces = '2,3' - Sorted = False - SynonymChars = '<>' - TabOrder = 4 - OnChange = ControlChange - OnNeedData = txtAttnNeedData - CharsNeedMatch = 1 - end - object treService: TORTreeView [12] - Left = 0 - Top = 38 - Width = 298 - Height = 220 - Anchors = [akLeft, akTop, akRight, akBottom] - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -9 - Font.Name = 'MS Sans Serif' - Font.Style = [] - HideSelection = False - Indent = 19 - ParentFont = False - ReadOnly = True - TabOrder = 2 - Visible = False - OnChange = treServiceChange - OnCollapsing = treServiceCollapsing - OnEnter = treServiceEnter - OnExit = treServiceExit - OnKeyDown = treServiceKeyDown - OnKeyUp = treServiceKeyUp - OnMouseDown = treServiceMouseDown - NodePiece = 0 - end - object cboCategory: TORComboBox [13] - Left = 225 - Top = -5 - Width = 5 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = False - LongList = False - LookupPiece = 0 - MaxLength = 0 - Sorted = False - SynonymChars = '<>' - TabOrder = 15 - Visible = False - CharsNeedMatch = 1 - end - object pnlServiceTreeButton: TKeyClickPanel [14] - Left = 274 - Top = 14 - Width = 26 - Height = 26 - Hint = 'View services/specialties hierarchically' - Anchors = [akTop, akRight] - BevelOuter = bvNone - BevelWidth = 2 - Caption = 'View services/specialties hierarchically' - Font.Charset = ANSI_CHARSET - Font.Color = clBtnFace - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 1 - TabStop = True - OnClick = btnServiceTreeClick - OnEnter = pnlServiceTreeButtonEnter - OnExit = pnlServiceTreeButtonExit - object btnServiceTree: TSpeedButton - Left = 2 - Top = 2 - Width = 22 - Height = 22 - Hint = 'View services/specialties hierarchically' - Glyph.Data = { - 26050000424D26050000000000003604000028000000100000000F0000000100 - 080000000000F000000000000000000000000001000000010000000000000000 - 80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA - A6000020400000206000002080000020A0000020C0000020E000004000000040 - 20000040400000406000004080000040A0000040C0000040E000006000000060 - 20000060400000606000006080000060A0000060C0000060E000008000000080 - 20000080400000806000008080000080A0000080C0000080E00000A0000000A0 - 200000A0400000A0600000A0800000A0A00000A0C00000A0E00000C0000000C0 - 200000C0400000C0600000C0800000C0A00000C0C00000C0E00000E0000000E0 - 200000E0400000E0600000E0800000E0A00000E0C00000E0E000400000004000 - 20004000400040006000400080004000A0004000C0004000E000402000004020 - 20004020400040206000402080004020A0004020C0004020E000404000004040 - 20004040400040406000404080004040A0004040C0004040E000406000004060 - 20004060400040606000406080004060A0004060C0004060E000408000004080 - 20004080400040806000408080004080A0004080C0004080E00040A0000040A0 - 200040A0400040A0600040A0800040A0A00040A0C00040A0E00040C0000040C0 - 200040C0400040C0600040C0800040C0A00040C0C00040C0E00040E0000040E0 - 200040E0400040E0600040E0800040E0A00040E0C00040E0E000800000008000 - 20008000400080006000800080008000A0008000C0008000E000802000008020 - 20008020400080206000802080008020A0008020C0008020E000804000008040 - 20008040400080406000804080008040A0008040C0008040E000806000008060 - 20008060400080606000806080008060A0008060C0008060E000808000008080 - 20008080400080806000808080008080A0008080C0008080E00080A0000080A0 - 200080A0400080A0600080A0800080A0A00080A0C00080A0E00080C0000080C0 - 200080C0400080C0600080C0800080C0A00080C0C00080C0E00080E0000080E0 - 200080E0400080E0600080E0800080E0A00080E0C00080E0E000C0000000C000 - 2000C0004000C0006000C0008000C000A000C000C000C000E000C0200000C020 - 2000C0204000C0206000C0208000C020A000C020C000C020E000C0400000C040 - 2000C0404000C0406000C0408000C040A000C040C000C040E000C0600000C060 - 2000C0604000C0606000C0608000C060A000C060C000C060E000C0800000C080 - 2000C0804000C0806000C0808000C080A000C080C000C080E000C0A00000C0A0 - 2000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0E000C0C00000C0C0 - 2000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0A000808080000000 - FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFF0700 - 07FFFFFFFFFFFFFFFFFFFFA4A407000400FF040404040404FFFFFFA4FFFF0700 - 07FFFFFFFFFFFFFFFFFFFFA4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA4FFFFFFFF - FFFF070007FFFFFFFFFFFFA4FFFFFFA4A407000400FF04040404FFA4FFFFFFA4 - FFFF070007FFFFFFFFFFFFA4FFFFFF07FFFFFFFFFFFFFFFFFFFFFFA4FFFF0700 - 07FFFFFFFFFFFFFFFFFFFFA4A407000400FF0404040404FFFFFFFFA4FFFF0700 - 07FFFFFFFFFFFFFFFFFFFF07FFFFFFFFFFFFFFFFFFFFFFFFFFFF070007FFFFFF - FFFFFFFFFFFFFFFFFFFF00FB00FF0404040404FFFFFFFFFFFFFF070007FFFFFF - FFFFFFFFFFFFFFFFFFFF} - Margin = 0 - ParentShowHint = False - ShowHint = True - OnClick = btnServiceTreeClick - end - end - object cmdLexSearch: TButton [15] - Left = 543 - Top = 94 - Width = 49 - Height = 21 - Anchors = [akTop, akRight] - Caption = 'Lexicon' - TabOrder = 9 - OnClick = cmdLexSearchClick - end - object gbInptOpt: TGroupBox [16] - Left = 309 - Top = 35 - Width = 140 - Height = 45 - Anchors = [akTop, akRight] - Caption = 'Patient will be seen as an:' - TabOrder = 5 - object radInpatient: TRadioButton - Left = 3 - Top = 20 - Width = 61 - Height = 13 - Caption = '&Inpatient' - TabOrder = 0 - OnClick = radInpatientClick - end - object radOutpatient: TRadioButton - Left = 67 - Top = 20 - Width = 70 - Height = 13 - Caption = '&Outpatient' - TabOrder = 1 - OnClick = radOutpatientClick - end - end - object btnDiagnosis: TButton [17] - Left = 543 - Top = 95 - Width = 49 - Height = 20 - Anchors = [akTop, akRight] - Caption = 'Diagnosis' - TabOrder = 7 - OnClick = btnDiagnosisClick - end - inherited cmdAccept: TButton - Left = 439 - Top = 315 - Anchors = [akLeft, akBottom] - TabOrder = 12 - ExplicitLeft = 439 - ExplicitTop = 315 + ExplicitLeft = 427 + ExplicitTop = 394 end inherited cmdQuit: TButton Left = 531 - Top = 315 + Top = 394 Width = 61 Anchors = [akLeft, akBottom] - TabOrder = 13 + TabOrder = 4 ExplicitLeft = 531 - ExplicitTop = 315 + ExplicitTop = 394 ExplicitWidth = 61 end inherited pnlMessage: TPanel Left = 13 - Top = 295 + Top = 374 Width = 377 Anchors = [akLeft, akRight, akBottom] - TabOrder = 14 + TabOrder = 5 ExplicitLeft = 13 - ExplicitTop = 295 + ExplicitTop = 374 ExplicitWidth = 377 inherited memMessage: TRichEdit @@ -436,10 +534,36 @@ Data = ( ( + 'Component = memOrder' + 'Status = stsDefault') + ( + 'Component = cmdAccept' + 'Status = stsDefault') + ( + 'Component = cmdQuit' + 'Status = stsDefault') + ( + 'Component = pnlMessage' + 'Status = stsDefault') + ( + 'Component = memMessage' + 'Status = stsDefault') + ( + 'Component = frmODCslt' + 'Status = stsDefault') + ( + 'Component = pnlMain' + 'Status = stsDefault') + ( + 'Component = lblLatest' + 'Status = stsDefault') + ( + 'Component = lblEarliest' + 'Status = stsDefault') + ( 'Component = pnlReason' 'Status = stsDefault') ( 'Component = memReason' - 'Label = lblReason' - 'Status = stsOK') + 'Status = stsDefault') ( 'Component = cboService' @@ -447,18 +571,14 @@ ( 'Component = cboUrgency' - 'Label = lblUrgency' - 'Status = stsOK') + 'Status = stsDefault') ( 'Component = cboPlace' - 'Label = lblPlace' - 'Status = stsOK') + 'Status = stsDefault') ( 'Component = txtProvDiag' - 'Label = lblProvDiag' - 'Status = stsOK') + 'Status = stsDefault') ( 'Component = txtAttn' - 'Label = lblAttn' - 'Status = stsOK') + 'Status = stsDefault') ( 'Component = treService' @@ -471,40 +591,37 @@ 'Status = stsDefault') ( + 'Component = gbInptOpt' + 'Status = stsDefault') + ( + 'Component = radInpatient' + 'Status = stsDefault') + ( + 'Component = radOutpatient' + 'Status = stsDefault') + ( + 'Component = btnDiagnosis' + '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' + 'Component = calEarliest' + 'Status = stsDefault') + ( + 'Component = calLatest' + 'Status = stsDefault') + ( + 'Component = pnlCombatVet' + 'Status = stsDefault') + ( + 'Component = txtCombatVet' + 'Status = stsDefault') + ( + 'Component = servicelbl508' 'Status = stsDefault')) end object mnuPopProvDx: TPopupMenu - Left = 353 - Top = 77 + Left = 489 + Top = 150 object mnuPopProvDxDelete: TMenuItem Caption = 'Delete diagnosis' @@ -514,6 +631,6 @@ object popReason: TPopupMenu OnPopup = popReasonPopup - Left = 411 - Top = 188 + Left = 547 + Top = 316 object popReasonCut: TMenuItem Caption = 'Cu&t' Index: cprs/trunk/CPRS-Chart/Consults/fODConsult.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fODConsult.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fODConsult.pas (revision 1679) @@ -9,8 +9,19 @@ fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons, Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet, - VA508AccessibilityManager ; + ORDtTm, VA508AccessibilityManager ; type TfrmODCslt = class(TfrmODBase) + pnlMain: TPanel; + lblService: TLabel; + lblProvDiag: TLabel; + lblUrgency: TLabel; + lblPlace: TLabel; + lblAttn: TLabel; + lblLatest: TStaticText; + lblEarliest: TStaticText; + pnlReason: TPanel; + lblReason: TLabel; + memReason: TRichEdit; cboService: TORComboBox; cboUrgency: TORComboBox; @@ -18,16 +29,17 @@ txtProvDiag: TCaptionEdit; txtAttn: TORComboBox; - lblService: TLabel; - lblUrgency: TLabel; - lblPlace: TLabel; - lblAttn: TLabel; - lblProvDiag: TLabel; treService: TORTreeView; cboCategory: TORComboBox; pnlServiceTreeButton: TKeyClickPanel; btnServiceTree: TSpeedButton; + gbInptOpt: TGroupBox; + radInpatient: TRadioButton; + radOutpatient: TRadioButton; + btnDiagnosis: TButton; + cmdLexSearch: TButton; + calEarliest: TORDateBox; + calLatest: TORDateBox; mnuPopProvDx: TPopupMenu; mnuPopProvDxDelete: TMenuItem; - cmdLexSearch: TButton; popReason: TPopupMenu; popReasonCut: TMenuItem; @@ -36,11 +48,7 @@ popReasonPaste2: TMenuItem; popReasonReformat: TMenuItem; - gbInptOpt: TGroupBox; - radInpatient: TRadioButton; - radOutpatient: TRadioButton; - pnlReason: TPanel; - lblReason: TLabel; - memReason: TRichEdit; - btnDiagnosis: TButton; + pnlCombatVet: TPanel; + txtCombatVet: TVA508StaticText; + servicelbl508: TVA508StaticText; procedure FormCreate(Sender: TObject); procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; @@ -96,4 +104,5 @@ FEditCtrl: TCustomEdit; FNavigatingTab: boolean; + LLS_LINE_INDEX: integer; procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode); procedure ReadServerVariables; @@ -107,4 +116,9 @@ procedure SetUpCopyConsultDiagnoses(pOrderID:string); procedure AdjustMemReasonSize; + function NotinIndex(AList: TStringList; i: integer): boolean; + function GetItemIndex(Service: String; Index: integer): integer; + procedure SetUpCombatVet; + procedure SetUpEarliestDate; //wat v28 + procedure setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox); protected procedure InitDialog; override; @@ -123,4 +137,6 @@ +function CanFreeConsultDialog(dialog : TfrmODBase) : boolean; + implementation @@ -129,5 +145,6 @@ uses rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq, - ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility; + ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility, + VA508AccessibilityRouter; var @@ -137,5 +154,5 @@ BADxUpdated: boolean; quickCode: string; - + AreGlobalsFree: boolean; @@ -156,8 +173,42 @@ TX_INACTIVE_CODE_REQD = 'Another code must be selected before the order can be saved.'; TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.'; + TX_PAST_DATE = 'Earliest appropriate date must be today or later.'; + TX_BAD_DATES = 'Latest appropriate date must be equal to or later than earliest date.'; TX_SVC_HRCHY = 'services/specialties hierarchy'; TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically'; TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view'; + + +{************** Static Unit Methods ***************} + +function CanFreeConsultDialog(dialog : TfrmODBase) : boolean; +begin + Result := true; + if (dialog is TfrmODCslt) then + Result := AreGlobalsFree; +end; + +procedure InitializeGlobalLists; +begin + Defaults := TStringList.Create; + SvcList := TStringList.Create; + QuickList := TStringList.Create; + AreGlobalsFree := false; +end; + +function FreeGlobalLists : Boolean; +begin + Result := false; + if AreGlobalsFree then + Exit; + Defaults.Free; + SvcList.Free; + QuickList.Free; + AreGlobalsFree := true; + Result := true; +end; + +{*************** TfrmODCslt Methods ***********} procedure TfrmODCslt.FormCreate(Sender: TObject); @@ -176,7 +227,5 @@ cmdLexSearch.Visible := True; end; - Defaults := TStringList.Create ; - SvcList := TStringList.Create ; - QuickList := TStringList.Create ; + InitializeGlobalLists; AllowQuickOrder := True; LastNode := 0; @@ -190,6 +239,19 @@ FastAssign(ODForConsults, Defaults); // ODForConsults returns TStrings with defaults CtrlInits.LoadDefaults(Defaults); + calEarliest.Text := 'TODAY'; + //calLatest.Text := 'TODAY+30'; txtAttn.InitLongList('') ; PreserveControl(txtAttn); + PreserveControl(calEarliest); + //PreserveControl(calLatest); + if (patient.CombatVet.IsEligible = True) then + begin + SetUpCombatVet; + end + else + begin + txtCombatVet.Enabled := False; + pnlCombatVet.SendToBack; + end; InitDialog; //Calling virtual SetFontSize in constructor is a bad idea! @@ -197,6 +259,4 @@ FcboServiceKeyDownStopClick := false; consultQuickOrder := false; - - end; @@ -233,10 +293,12 @@ memReason.Clear; cboService.Enabled := True; + setup508Label(servicelbl508, cboService); cboService.Font.Color := clWindowText; - cboService.Height := 25 + (7 * cboService.ItemHeight); + cboService.Height := 25 + (11 * cboService.ItemHeight); btnServiceTree.Enabled := True; pnlServiceTreeButton.Enabled := True; SetProvDiagPromptingMode; - ActiveControl := cboService; // set after call to SetProvDiagPromptingMode + ActiveControl := cboService; + Changing := False; StatusText(''); @@ -258,4 +320,5 @@ begin inherited; + LLS_LINE_INDEX := -1; ReadServerVariables; AList := TStringList.Create; @@ -281,4 +344,5 @@ Exit; end; + cboService.Items.Add(SvcIEN + U + tmpResp.EValue + '^^^^' + tmpResp.IValue); cboService.SelectByID(SvcIEN); @@ -289,8 +353,12 @@ else radOutpatient.Checked := True ; - SetControl(cboUrgency, 'URGENCY', 1); + SetUpEarliestDate; //wat v28 + SetControl(cboUrgency, 'URGENCY', 1); SetControl(cboPlace, 'PLACE', 1); SetControl(txtAttn, 'PROVIDER', 1); + SetControl(calEarliest, 'EARLIEST', 1); + //SetControl(calLatest, 'LATEST', 1); cboService.Enabled := False; + setup508Label(servicelbl508, cboService); cboService.Font.Color := clGrayText; btnServiceTree.Enabled := False; @@ -308,4 +376,5 @@ begin AbortOrder := True; + SetTemplateDialogCanceled(FALSE); Close; Exit; @@ -316,4 +385,5 @@ begin AbortOrder := True; + SetTemplateDialogCanceled(FALSE); Close; Exit; @@ -343,9 +413,11 @@ FastAssign(QuickList, cboService.Items); Items.Add(LLS_LINE); + LLS_LINE_INDEX := Items.IndexOf(Trim(Piece(LLS_LINE, U, 2))); {TP - HDS00015782: Used to determine if QO} Items.Add(LLS_SPACE); end; Changing := True; for i := 0 to AList.Count - 1 do - if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and {RV} + //if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and {RV} + if (NotinIndex(AList,i)) and {TP - HDS00015782: Check if service is already in index (not including QO)} //if (cboService.SelectByID(Piece(AList.Strings[i], U, 1)) = -1) and (Piece(AList.Strings[i], U, 5) <> '1') then @@ -410,4 +482,7 @@ SetError(TX_SELECT_DIAG); end; + if (lblEarliest.Enabled) and (calEarliest.FMDateTime < FMToday) then SetError(TX_PAST_DATE); + //if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE); + //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES); end; @@ -548,4 +623,5 @@ FLastServiceID := ItemID; cboService.Enabled := False; + setup508Label(servicelbl508, cboService); cboService.Font.Color := clGrayText; btnServiceTree.Enabled := False; @@ -588,4 +664,6 @@ SetControl(cboPlace, 'PLACE', 1); SetControl(txtAttn, 'PROVIDER', 1); + SetControl(calEarliest, 'EARLIEST', 1); + //SetControl(calLatest, 'LATEST', 1); SetTemplateDialogCanceled(FALSE); SetControl(memReason, 'COMMENT', 1); @@ -593,4 +671,5 @@ begin AbortOrder := TRUE; + SetTemplateDialogCanceled(FALSE); Close; Exit; @@ -616,4 +695,5 @@ end; SetProvDiagPromptingMode; + SetUpEarliestDate; //wat v28 tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6); pnlMessage.TabOrder := treService.TabOrder + 1; @@ -646,9 +726,11 @@ else Responses.Update('ORDERABLE', 1, '', ''); end; - with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text); - with cboCategory do if ItemID <> '' then Responses.Update('CLASS', 1, ItemID, Text); - with cboUrgency do if ItemIEN > 0 then Responses.Update('URGENCY', 1, ItemID, Text); - with cboPlace do if ItemID <> '' then Responses.Update('PLACE', 1, ItemID, Text); - with txtAttn do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text); + with memReason do Responses.Update('COMMENT', 1, TX_WPTYPE, Text); + with cboCategory do Responses.Update('CLASS', 1, ItemID, Text); + with cboUrgency do Responses.Update('URGENCY', 1, ItemID, Text); + with cboPlace do Responses.Update('PLACE', 1, ItemID, Text); + with txtAttn do Responses.Update('PROVIDER', 1, ItemID, Text); + with calEarliest do if Length(Text) > 0 then Responses.Update('EARLIEST', 1, Text, Text); + //with calLatest do if Length(Text) > 0 then Responses.Update('LATEST', 1, Text, Text); //with txtProvDiag do if Length(Text) > 0 then Responses.Update('MISC', 1, Text, Text); if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text) @@ -758,4 +840,5 @@ with cboService do begin + setup508Label(servicelbl508, cboService); if (ItemIndex < 0) or (ItemID = '') then begin @@ -779,7 +862,9 @@ Changing := True; Responses.QuickOrder := ExtractInteger(ItemID); - consultQuickOrder := True; + consultQuickOrder := True; tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).EValue; ItemIndex := Items.IndexOf(Trim(tmpSvc)); + If ItemIndex < LLS_LINE_INDEX then {TP - HDS00015782: Check if index is of a QO} + ItemIndex := GetItemIndex(tmpSvc,ItemIndex); (* tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue; for i := 0 to Items.Count-1 do @@ -793,4 +878,5 @@ FLastServiceID := ItemID; Enabled := False; + setup508Label(servicelbl508, cboService); Font.Color := clGrayText; btnServiceTree.Enabled := False; @@ -811,4 +897,6 @@ SetControl(cboPlace, 'PLACE', 1); SetControl(txtAttn, 'PROVIDER', 1); + SetControl(calEarliest, 'EARLIEST', 1); + //SetControl(calLatest, 'LATEST', 1); SetTemplateDialogCanceled(FALSE); SetControl(memReason, 'COMMENT', 1); @@ -816,4 +904,5 @@ begin AbortOrder := TRUE; + SetTemplateDialogCanceled(FALSE); Close; Exit; @@ -861,11 +950,12 @@ //OrderMessage(ConsultMessage(cboService.ItemIEN)); ControlChange(Self) ; + SetUpEarliestDate; //wat v28 + setup508Label(servicelbl508, cboService); end; procedure TfrmODCslt.FormDestroy(Sender: TObject); begin - Defaults.Free; - SvcList.Free ; - QuickList.Free; + if not FreeGlobalLists then + Exit; inherited; end; @@ -986,5 +1076,4 @@ ProvDx.Text := Copy(ProvDx.Text, 1, i - 1); txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')'; - ProvDx.CodeInactive := False; end; @@ -1057,4 +1146,15 @@ +procedure TfrmODCslt.setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox); +begin + if ScreenReaderSystemActive and not ctrl.Enabled then begin + lbl.Enabled := True; + lbl.Visible := True; + lbl.Caption := lblService.Caption + ', ' + ctrl.Text; + lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left; + end else + lbl.Visible := false; +end; + procedure TfrmODCslt.mnuPopProvDxDeleteClick(Sender: TObject); begin @@ -1493,4 +1593,71 @@ pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE; pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE; + if patient.CombatVet.IsEligible then pnlReason.Height := pnlReason.Height - PIXEL_SPACE*20; +end; + +function TfrmODCslt.NotinIndex(AList: TStringList; i: integer): Boolean; {TP - HDS00015782:} +{This function determines if a Consult Service will be added to the cboService +component. If name does not exist or if name does not exist below the Quick +Order listing, then it is added.} +var + x: Integer; + y: String; +begin + Result := False; + x := cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))); + if (x = -1) then + Result := True; + if (x <> -1) and (x < LLS_LINE_INDEX) then + begin + y := cboService.Items[x]; + cboService.Items.Delete(x); + if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) then + Result := True; + cboService.Items.Insert(x,y); + end; + +end; + +function TfrmODCslt.GetItemIndex(Service: String; Index: integer): integer; {TP - HDS00015782:} +{This function returns ItemIndexOf value for Service Consult when a Quick Order +has the exact same name} +var + y: String; + +begin + y := cboService.Items[Index]; + cboService.Items.Delete(Index); + Result := (cboService.Items.IndexOf(Trim(Service)) + 1); + cboService.Items.Insert(Index,y); +end; + +procedure TfrmODCslt.SetUpCombatVet; +begin + pnlCombatVet.BringToFront; + txtCombatVet.Enabled := True; + txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate; + pnlMain.Top := pnlMain.Top + pnlCombatVet.Height; + pnlMain.Anchors := [akLeft,akTop,akRight]; + treService.Anchors := [akLeft,akTop,akRight]; + self.Height := self.Height + pnlCombatVet.Height; + treService.Anchors := [akLeft,akTop,akRight,akBottom]; + pnlMain.Anchors := [akLeft,akTop,akRight,akBottom]; +end; + +procedure TfrmODCslt.SetUpEarliestDate; //wat v28 +begin + if IsProstheticsService(cboService.ItemIEN) = '1' then + begin + lblEarliest.Enabled := False; + calEarliest.Enabled := False; + calEarliest.Text := ''; + Responses.Update('EARLIEST',1,'',''); + end + else + begin + lblEarliest.Enabled := True; + calEarliest.Enabled := True; + calEarliest.Text := 'TODAY'; + end; end; Index: cprs/trunk/CPRS-Chart/Consults/fODProc.dfm =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fODProc.dfm (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fODProc.dfm (revision 1679) @@ -1,119 +1,54 @@ inherited frmODProc: TfrmODProc Tag = 112 - Left = 208 - Top = 188 - Width = 543 - Height = 393 + Left = 430 + Top = 203 + Width = 606 + Height = 442 HorzScrollBar.Range = 523 VertScrollBar.Range = 295 + Anchors = [akLeft, akTop, akRight, akBottom] Caption = 'Order a Procedure' - Constraints.MinHeight = 393 - Constraints.MinWidth = 543 - ExplicitLeft = 208 - ExplicitTop = 188 - ExplicitWidth = 543 - ExplicitHeight = 393 + Constraints.MinHeight = 442 + Constraints.MinWidth = 606 + Position = poDesigned + OnShow = FormShow + ExplicitWidth = 606 + ExplicitHeight = 442 PixelsPerInch = 96 TextHeight = 13 - object lblProc: TLabel [0] - Left = 4 - Top = 4 - Width = 49 - Height = 13 - Caption = 'Procedure' - end - object lblService: TOROffsetLabel [1] - Left = 4 - Top = 42 - Width = 158 - Height = 15 - Caption = 'Service to perform this procedure' - HorzOffset = 2 - Transparent = False - VertOffset = 2 - WordWrap = False - end - object lblReason: TLabel [2] - Left = 4 - Top = 103 - Width = 95 - Height = 13 - Caption = 'Reason for Request' - end - object lblUrgency: TStaticText [3] - Left = 249 - Top = 4 - Width = 44 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Urgency' - TabOrder = 15 - end - object lblPlace: TStaticText [4] - Left = 396 - Top = 43 - Width = 104 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Place of Consultation' - TabOrder = 16 - end - object lblAttn: TStaticText [5] - Left = 396 - Top = 4 - Width = 46 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Attention' - TabOrder = 17 - end - object lblProvDiag: TStaticText [6] - Left = 249 - Top = 81 - Width = 104 - Height = 17 - Anchors = [akTop, akRight] - Caption = 'Provisional Diagnosis' - TabOrder = 18 - end - object pnlReason: TPanel [7] + object pnlCombatVet: TPanel [0] Left = 0 - Top = 120 - Width = 528 - Height = 192 - Anchors = [akLeft, akTop, akRight, akBottom] - BevelOuter = bvNone - TabOrder = 9 - object memReason: TCaptionRichEdit - Left = 0 - Top = 0 - Width = 528 - Height = 192 + Top = 0 + Width = 598 + Height = 25 + Align = alTop + BevelOuter = bvLowered + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 0 + object txtCombatVet: TVA508StaticText + Name = 'txtCombatVet' + Left = 1 + Top = 1 + Width = 596 + Height = 23 Align = alClient - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Courier New' - Font.Style = [] - Constraints.MinHeight = 40 - ParentFont = False - PopupMenu = popReason - ScrollBars = ssBoth + Alignment = taCenter + BevelOuter = bvNone + Enabled = False TabOrder = 0 - WantTabs = True - OnChange = ControlChange - OnExit = memReasonExit - OnKeyDown = memReasonKeyDown - OnKeyPress = memReasonKeyPress - OnKeyUp = memReasonKeyUp - Caption = 'Reason for Request' + ShowAccelChar = True end end inherited memOrder: TCaptionMemo Left = 0 - Top = 321 + Top = 365 Width = 380 Height = 41 - Anchors = [akLeft, akRight] + Anchors = [akLeft, akRight, akBottom] Lines.Strings = ( 'The order text...' @@ -122,238 +57,402 @@ '--------------' 'An order message may be displayed here.') - TabOrder = 1 + ParentFont = False + TabOrder = 3 ExplicitLeft = 0 - ExplicitTop = 321 + ExplicitTop = 365 ExplicitWidth = 380 ExplicitHeight = 41 end - object cboUrgency: TORComboBox [9] - Left = 249 - Top = 17 - Width = 133 - Height = 21 - Anchors = [akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Urgency' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 2 - OnChange = ControlChange - CharsNeedMatch = 1 - end - object cboPlace: TORComboBox [10] - Left = 396 - Top = 56 - Width = 133 - Height = 21 - Anchors = [akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Place of Consultation' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 6 - OnChange = ControlChange - CharsNeedMatch = 1 - end - object txtAttn: TORComboBox [11] - Left = 396 - Top = 17 - Width = 133 - Height = 21 - Anchors = [akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Attention' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = True - LookupPiece = 2 - MaxLength = 0 - Pieces = '2,3' - Sorted = False - SynonymChars = '<>' - TabOrder = 3 - OnChange = ControlChange - OnNeedData = txtAttnNeedData - CharsNeedMatch = 1 - end - object cboProc: TORComboBox [12] - Left = 4 - Top = 17 - Width = 227 - Height = 21 - Anchors = [akLeft, akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Procedure' - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = True - LongList = True - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' - TabOrder = 0 - OnChange = cboProcSelect - OnNeedData = cboProcNeedData - CharsNeedMatch = 1 - end - object cboCategory: TORComboBox [13] - Left = 516 - Top = 10 - Width = 3 - Height = 21 - Style = orcsDropDown - AutoSelect = True - Color = clWindow - DropDownCount = 8 - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = False - LongList = False - LookupPiece = 0 - MaxLength = 0 - Sorted = False - SynonymChars = '<>' - TabOrder = 13 - Visible = False - OnChange = ControlChange - CharsNeedMatch = 1 - end - object cboService: TORComboBox [14] - Left = 4 - Top = 58 - Width = 227 - Height = 21 - Anchors = [akLeft, akTop, akRight] - Style = orcsDropDown - AutoSelect = True - Caption = 'Service to perform this procedure' - Color = clWindow - DropDownCount = 8 - Enabled = False - ItemHeight = 13 - ItemTipColor = clWindow - ItemTipEnable = True - ListItemsOnly = False - LongList = False - LookupPiece = 0 - MaxLength = 0 - Pieces = '2' - Sorted = False - SynonymChars = '<>' + object pnlMain: TPanel [2] + Left = 0 + Top = 0 + Width = 598 + Height = 354 + Anchors = [akLeft, akTop, akRight, akBottom] + BevelOuter = bvNone + TabOrder = 1 + DesignSize = ( + 598 + 354) + object lblProc: TLabel + Left = 4 + Top = 4 + Width = 49 + Height = 13 + Caption = 'Procedure' + end + object lblService: TOROffsetLabel + Left = 4 + Top = 114 + Width = 158 + Height = 15 + Caption = 'Service to perform this procedure' + HorzOffset = 2 + Transparent = False + VertOffset = 2 + WordWrap = False + end + object lblReason: TLabel + Left = 8 + Top = 165 + Width = 95 + Height = 13 + Margins.Left = 0 + Caption = 'Reason for Request' + end + object lblUrgency: TStaticText + Left = 312 + Top = 4 + Width = 44 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Urgency' + TabOrder = 13 + end + object lblPlace: TStaticText + Left = 460 + Top = 92 + Width = 104 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Place of Consultation' + TabOrder = 14 + end + object lblAttn: TStaticText + Left = 460 + Top = 4 + Width = 46 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Attention' + TabOrder = 15 + end + object lblProvDiag: TStaticText + Left = 312 + Top = 135 + Width = 104 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Provisional Diagnosis' + TabOrder = 16 + end + object pnlReason: TPanel + Left = 0 + Top = 184 + Width = 591 + Height = 166 + Anchors = [akLeft, akTop, akRight, akBottom] + BevelOuter = bvNone + TabOrder = 11 + object memReason: TCaptionRichEdit + Left = 0 + Top = 0 + Width = 591 + Height = 166 + Align = alClient + Anchors = [akLeft, akTop, akRight] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + Constraints.MinHeight = 40 + ParentFont = False + PopupMenu = popReason + ScrollBars = ssBoth + TabOrder = 0 + WantTabs = True + OnChange = ControlChange + OnExit = memReasonExit + OnKeyDown = memReasonKeyDown + OnKeyPress = memReasonKeyPress + OnKeyUp = memReasonKeyUp + Caption = 'Reason for Request' + end + end + object cboUrgency: TORComboBox + Left = 312 + Top = 17 + Width = 133 + Height = 21 + Anchors = [akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Urgency' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 3 + OnChange = ControlChange + CharsNeedMatch = 1 + end + object cboPlace: TORComboBox + Left = 460 + Top = 105 + Width = 133 + Height = 21 + Anchors = [akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Place of Consultation' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 8 + OnChange = ControlChange + CharsNeedMatch = 1 + end + object txtAttn: TORComboBox + Left = 460 + Top = 17 + Width = 131 + Height = 21 + Anchors = [akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Attention' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = True + LookupPiece = 2 + MaxLength = 0 + Pieces = '2,3' + Sorted = False + SynonymChars = '<>' + TabOrder = 4 + OnChange = ControlChange + OnNeedData = txtAttnNeedData + CharsNeedMatch = 1 + end + object cboProc: TORComboBox + Left = 4 + Top = 17 + Width = 290 + Height = 91 + Anchors = [akLeft, akTop, akRight] + Style = orcsSimple + AutoSelect = True + Caption = 'Procedure' + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = True + LongList = True + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 0 + OnChange = cboProcSelect + OnNeedData = cboProcNeedData + CharsNeedMatch = 1 + end + object cboCategory: TORComboBox + Left = 516 + Top = 10 + Width = 3 + Height = 21 + Style = orcsDropDown + AutoSelect = True + Color = clWindow + DropDownCount = 8 + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = False + LongList = False + LookupPiece = 0 + MaxLength = 0 + Sorted = False + SynonymChars = '<>' + TabOrder = 12 + Visible = False + OnChange = ControlChange + CharsNeedMatch = 1 + end + object cboService: TORComboBox + Left = 4 + Top = 130 + Width = 290 + Height = 21 + Anchors = [akLeft, akTop, akRight] + Style = orcsDropDown + AutoSelect = True + Caption = 'Service to perform this procedure' + Color = clWindow + DropDownCount = 8 + Enabled = False + ItemHeight = 13 + ItemTipColor = clWindow + ItemTipEnable = True + ListItemsOnly = False + LongList = False + LookupPiece = 0 + MaxLength = 0 + Pieces = '2' + Sorted = False + SynonymChars = '<>' + TabOrder = 1 + OnChange = cboServiceChange + CharsNeedMatch = 1 + end + object cmdLexSearch: TButton + Left = 549 + Top = 149 + Width = 49 + Height = 21 + Anchors = [akTop, akRight] + Caption = 'Lexicon' + TabOrder = 10 + OnClick = cmdLexSearchClick + end + object gbInptOpt: TGroupBox + Left = 312 + Top = 85 + Width = 140 + Height = 45 + Anchors = [akTop, akRight] + Caption = 'Patient will be seen as an:' + TabOrder = 7 + object radInpatient: TRadioButton + Left = 3 + Top = 20 + Width = 61 + Height = 17 + Caption = '&Inpatient' + TabOrder = 1 + OnClick = radInpatientClick + end + object radOutpatient: TRadioButton + Left = 67 + Top = 20 + Width = 71 + Height = 17 + Caption = '&Outpatient' + TabOrder = 0 + OnClick = radOutpatientClick + end + end + object txtProvDiag: TCaptionEdit + Left = 312 + Top = 149 + Width = 234 + Height = 21 + Anchors = [akTop, akRight] + MaxLength = 180 + ParentShowHint = False + PopupMenu = mnuPopProvDx + ShowHint = True + TabOrder = 9 + OnChange = txtProvDiagChange + Caption = 'Provisional Diagnosis' + end + object lblEarliest: TStaticText + Left = 312 + Top = 44 + Width = 121 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Earliest appropriate date:' + TabOrder = 18 + end + object calEarliest: TORDateBox + Left = 312 + Top = 58 + Width = 133 + Height = 21 + Anchors = [akTop, akRight] + TabOrder = 5 + OnChange = ControlChange + DateOnly = True + RequireTime = False + end + object lblLatest: TStaticText + Left = 460 + Top = 44 + Width = 116 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Latest appropriate date:' + TabOrder = 19 + Visible = False + end + object calLatest: TORDateBox + Left = 460 + Top = 58 + Width = 131 + Height = 21 + Anchors = [akTop, akRight] + TabOrder = 6 + Visible = False + OnChange = ControlChange + DateOnly = True + RequireTime = False + end + object servicelbl508: TVA508StaticText + Name = 'servicelbl508' + Left = 183 + Top = 114 + Width = 106 + Height = 15 + Alignment = taLeftJustify + Caption = 'service (for screen R.)' + Enabled = False + TabOrder = 2 + Visible = False + ShowAccelChar = True + end + end + inherited cmdAccept: TButton + Left = 427 + Top = 382 + Anchors = [akRight, akBottom] TabOrder = 4 - OnChange = cboServiceChange - CharsNeedMatch = 1 - end - object cmdLexSearch: TButton [15] - Left = 486 - Top = 93 - Width = 49 - Height = 21 - Anchors = [akTop, akRight] - Caption = 'Lexicon' - TabOrder = 8 - OnClick = cmdLexSearchClick - end - object gbInptOpt: TGroupBox [16] - Left = 249 - Top = 36 - Width = 140 - Height = 45 - Anchors = [akTop, akRight] - Caption = 'Patient will be seen as an:' - TabOrder = 5 - object radInpatient: TRadioButton - Left = 3 - Top = 20 - Width = 61 - Height = 17 - Caption = '&Inpatient' - TabOrder = 0 - OnClick = radInpatientClick - end - object radOutpatient: TRadioButton - Left = 67 - Top = 20 - Width = 71 - Height = 17 - Caption = '&Outpatient' - TabOrder = 1 - OnClick = radOutpatientClick - end - end - object txtProvDiag: TCaptionEdit [17] - Left = 249 - Top = 93 - Width = 234 - Height = 21 - Anchors = [akTop, akRight] - MaxLength = 180 - ParentShowHint = False - PopupMenu = mnuPopProvDx - ShowHint = True - TabOrder = 7 - OnChange = txtProvDiagChange - Caption = 'Provisional Diagnosis' - end - inherited cmdAccept: TButton - Left = 387 - Top = 339 - Anchors = [akRight, akBottom] - TabOrder = 10 - ExplicitLeft = 387 - ExplicitTop = 339 + ExplicitLeft = 427 + ExplicitTop = 382 end inherited cmdQuit: TButton - Left = 469 - Top = 339 + Left = 526 + Top = 382 Width = 64 Anchors = [akRight, akBottom] - TabOrder = 11 - ExplicitLeft = 469 - ExplicitTop = 339 + TabOrder = 5 + ExplicitLeft = 526 + ExplicitTop = 382 ExplicitWidth = 64 end inherited pnlMessage: TPanel - Left = 50 - Top = 320 + Left = 13 + Top = 361 Width = 316 Anchors = [akLeft, akRight, akBottom] - TabOrder = 12 - ExplicitLeft = 50 - ExplicitTop = 320 + TabOrder = 2 + ExplicitLeft = 13 + ExplicitTop = 361 ExplicitWidth = 316 inherited memMessage: TRichEdit @@ -365,4 +464,28 @@ Data = ( ( + 'Component = memOrder' + 'Status = stsDefault') + ( + 'Component = cmdAccept' + 'Status = stsDefault') + ( + 'Component = cmdQuit' + 'Status = stsDefault') + ( + 'Component = pnlMessage' + 'Status = stsDefault') + ( + 'Component = memMessage' + 'Status = stsDefault') + ( + 'Component = frmODProc' + 'Status = stsDefault') + ( + 'Component = pnlMain' + 'Status = stsDefault') + ( + 'Component = pnlCombatVet' + 'Status = stsDefault') + ( 'Component = lblUrgency' 'Status = stsDefault') @@ -416,25 +539,25 @@ 'Status = stsDefault') ( - 'Component = memOrder' - 'Status = stsDefault') - ( - 'Component = cmdAccept' - 'Status = stsDefault') - ( - 'Component = cmdQuit' - 'Status = stsDefault') - ( - 'Component = pnlMessage' - 'Status = stsDefault') - ( - 'Component = memMessage' - 'Status = stsDefault') - ( - 'Component = frmODProc' + 'Component = lblEarliest' + 'Status = stsDefault') + ( + 'Component = calEarliest' + 'Status = stsDefault') + ( + 'Component = lblLatest' + 'Status = stsDefault') + ( + 'Component = calLatest' + 'Status = stsDefault') + ( + 'Component = txtCombatVet' + 'Status = stsDefault') + ( + 'Component = servicelbl508' 'Status = stsDefault')) end object mnuPopProvDx: TPopupMenu Left = 353 - Top = 77 + Top = 133 object mnuPopProvDxDelete: TMenuItem Caption = 'Delete diagnosis' @@ -444,6 +567,6 @@ object popReason: TPopupMenu OnPopup = popReasonPopup - Left = 411 - Top = 169 + Left = 483 + Top = 337 object popReasonCut: TMenuItem Caption = 'Cu&t' Index: cprs/trunk/CPRS-Chart/Consults/fODProc.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fODProc.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fODProc.pas (revision 1679) @@ -6,23 +6,36 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons, - Menus, VA508AccessibilityManager; + Menus, ORDtTm, VA508AccessibilityManager; type TfrmODProc = class(TfrmODBase) - cboUrgency: TORComboBox; - cboPlace: TORComboBox; - txtAttn: TORComboBox; + pnlMain: TPanel; + pnlCombatVet: TPanel; lblProc: TLabel; - cboProc: TORComboBox; + lblService: TOROffsetLabel; + lblReason: TLabel; lblUrgency: TStaticText; lblPlace: TStaticText; lblAttn: TStaticText; lblProvDiag: TStaticText; + pnlReason: TPanel; + memReason: TCaptionRichEdit; + cboUrgency: TORComboBox; + cboPlace: TORComboBox; + txtAttn: TORComboBox; + cboProc: TORComboBox; cboCategory: TORComboBox; cboService: TORComboBox; - lblService: TOROffsetLabel; + cmdLexSearch: TButton; + gbInptOpt: TGroupBox; + radInpatient: TRadioButton; + radOutpatient: TRadioButton; + txtProvDiag: TCaptionEdit; + lblEarliest: TStaticText; + calEarliest: TORDateBox; + lblLatest: TStaticText; + calLatest: TORDateBox; mnuPopProvDx: TPopupMenu; mnuPopProvDxDelete: TMenuItem; - cmdLexSearch: TButton; popReason: TPopupMenu; popReasonCut: TMenuItem; @@ -31,11 +44,6 @@ popReasonPaste2: TMenuItem; popReasonReformat: TMenuItem; - pnlReason: TPanel; - memReason: TCaptionRichEdit; - gbInptOpt: TGroupBox; - radInpatient: TRadioButton; - radOutpatient: TRadioButton; - txtProvDiag: TCaptionEdit; - lblReason: TLabel; + txtCombatVet: TVA508StaticText; + servicelbl508: TVA508StaticText; procedure FormCreate(Sender: TObject); procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; @@ -64,4 +72,5 @@ procedure FormResize(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormShow(Sender: TObject); private FLastProcID: string; @@ -74,4 +83,7 @@ function ShowPrerequisites: boolean; procedure DoSetFontSize( FontSize: integer); + procedure SetUpCombatVet; + procedure updateService; + procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl); protected procedure InitDialog; override; @@ -83,4 +95,7 @@ end; + +function CanFreeProcDialog(dialog : TfrmODBase) : boolean; + implementation @@ -89,10 +104,12 @@ uses rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses, - clipbrd, fPreReq, uTemplates, fFrame, uODBase, - uVA508CPRSCompatibility; + clipbrd, fPreReq, uTemplates, fFrame, uODBase, VA508AccessibilityRouter, + uVA508CPRSCompatibility; + var ProvDx: TProvisionalDiagnosis; GMRCREAF: string; + OkToFreeProcDialog: boolean; const @@ -108,4 +125,17 @@ TX_INACTIVE_CODE_REQD = 'Another code must be selected before the order can be saved.'; TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.'; + TX_PAST_DATE = 'Earliest appropriate date must be today or later.'; + TX_BAD_DATES = 'Latest appropriate date must be equal to or later than earliest date.'; + +{ ********* Static Unit Methods ************ } + +function CanFreeProcDialog(dialog : TfrmODBase) : boolean; +begin + Result := true; + if (dialog is TfrmODProc) then + Result := OkToFreeProcDialog; +end; + +{ ********************* TfrmODProc Methods **************** } procedure TfrmODProc.FormCreate(Sender: TObject); @@ -114,4 +144,5 @@ AutoSizeDisabled := True; inherited; + OkToFreeProcDialog := False; DoSetFontSize(MainFontSize); AllowQuickOrder := True; @@ -126,6 +157,19 @@ cboProc.InitLongList('') ; txtAttn.InitLongList('') ; + calEarliest.Text := 'TODAY'; + //calLatest.Text := 'TODAY+30'; + PreserveControl(calEarliest); + //PreserveControl(calLatest); PreserveControl(txtAttn); PreserveControl(cboProc); + if (patient.CombatVet.IsEligible = True) then + begin + SetUpCombatVet; + end + else + begin + txtCombatVet.Enabled := False; + pnlCombatVet.SendToBack; + end; InitDialog; end; @@ -198,4 +242,6 @@ SetControl(cboPlace, 'PLACE', 1); SetControl(txtAttn, 'PROVIDER', 1); + SetControl(calEarliest, 'EARLIEST', 1); + //SetControl(calLatest, 'LATEST', 1); cboProc.Enabled := False; cboProc.Font.Color := clGrayText; @@ -229,5 +275,7 @@ if WasTemplateDialogCanceled then begin - AbortOrder := True; + AbortOrder := True; + OkToFreeProcDialog := true; + SetTemplateDialogCanceled(FALSE); Close; Exit; @@ -238,4 +286,6 @@ begin AbortOrder := True; + OkToFreeProcDialog := true; + SetTemplateDialogCanceled(FALSE); Close; Exit; @@ -258,6 +308,6 @@ inherited; if cboProc.ItemIEN = 0 then SetError(TX_NO_PROC); - if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY); - if cboPlace.ItemID = '' then SetError(TX_NO_PLACE); + if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY); + if cboPlace.ItemID = '' then SetError(TX_NO_PLACE); if (not ContainsVisibleChar(memReason.Text)) then SetError(TX_NO_REASON); @@ -265,9 +315,12 @@ if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then begin - if ProvDx.PromptMode = 'F' then + if ProvDx.PromptMode = 'F' then SetError(TX_NO_DIAG) else SetError(TX_SELECT_DIAG); end; + if calEarliest.FMDateTime < FMToday then SetError(TX_PAST_DATE); + //if calLatest.FMDateTime < FMToday then SetError(TX_PAST_DATE); + //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES); end; @@ -337,8 +390,5 @@ else Responses.Update('ORDERABLE', 1, '', ''); end; -(* with cboProc do if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text) - else Responses.Update('ORDERABLE', 1, '', '');*) - with cboService do if ItemIEN > 0 then Responses.Update('SERVICE', 1, ItemID, Text) - else Responses.Update('SERVICE', 1, '', ''); + updateService(); with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text); with cboCategory do if ItemID <> '' then Responses.Update('CLASS', 1, ItemID, Text); @@ -346,4 +396,6 @@ with cboPlace do if ItemID <> '' then Responses.Update('PLACE', 1, ItemID, Text); with txtAttn do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text); + with calEarliest do if Length(Text) > 0 then Responses.Update('EARLIEST', 1, Text, Text); + //with calLatest do if Length(Text) > 0 then Responses.Update('LATEST', 1, Text, Text); if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text) else Responses.Update('MISC', 1, '', ''); @@ -415,4 +467,6 @@ SetControl(cboPlace, 'PLACE', 1); SetControl(txtAttn, 'PROVIDER', 1); + SetControl(calEarliest, 'EARLIEST', 1); + //SetControl(calLatest, 'LATEST', 1); SetTemplateDialogCanceled(FALSE); SetControl(memReason, 'COMMENT', 1); @@ -588,4 +642,15 @@ end; +procedure TfrmODProc.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl); +begin + if ScreenReaderSystemActive and not ctrl.Enabled then begin + lbl.Enabled := True; + lbl.Visible := True; + lbl.Caption := lblService.Caption + ', ' + Text; + lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left; + end else + lbl.Visible := false; +end; + procedure TfrmODProc.cboServiceChange(Sender: TObject); begin @@ -813,4 +878,18 @@ end; +procedure TfrmODProc.updateService; +begin + with cboService do + if ItemIEN > 0 then + begin + setup508Label(Text, servicelbl508, cboService); + Responses.Update('SERVICE', 1, ItemID, Text); + end + else begin + Responses.Update('SERVICE', 1, '', ''); + setup508Label('No service selected.', servicelbl508, cboService); + end; +end; + procedure TfrmODProc.DoSetFontSize(FontSize: integer); begin @@ -840,6 +919,19 @@ begin inherited; - memOrder.Top := PnlReason.Top + PnlReason.Height + 5; - + if Patient.CombatVet.IsEligible then + begin + memOrder.Top := pnlCombatVet.Height + PnlReason.Top + PnlReason.Height + 7; + end + else + begin + memOrder.Top := PnlReason.Top + PnlReason.Height + 7; + end; + +end; + +procedure TfrmODProc.FormShow(Sender: TObject); +begin + inherited; + setup508Label('No service selected.', servicelbl508, cboService); end; @@ -850,4 +942,15 @@ end; +procedure TfrmODProc.SetUpCombatVet; + begin + pnlCombatVet.BringToFront; + txtCombatVet.Enabled := True; + txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate; + pnlMain.Top := pnlMain.Top + pnlCombatVet.Height; + pnlMain.Anchors := [akLeft,akTop,akRight]; + self.Height := self.Height + pnlCombatVet.Height; + pnlMain.Anchors := [akLeft,akTop,akRight,akBottom]; + end; + end. Index: cprs/trunk/CPRS-Chart/Consults/fPreReq.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/fPreReq.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/fPreReq.pas (revision 1679) @@ -137,5 +137,4 @@ with Lines do begin - AddStrings(AHeader); for i := 0 to MaxLines do if i < memReport.Lines.Count then @@ -157,5 +156,5 @@ end; until LastLine >= memReport.Lines.Count - 1; - PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg); + PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg, True); end; finally @@ -185,6 +184,7 @@ begin inherited; + SetFormPosition(Self); //Get Saved Position & Size of Form ResizeAnchoredFormToFont(Self); - SetFormPosition(Self); //Get Saved Position & Size of Form + //SetFormPosition(Self); //Get Saved Position & Size of Form end; Index: cprs/trunk/CPRS-Chart/Consults/rConsults.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/rConsults.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/rConsults.pas (revision 1679) @@ -96,4 +96,5 @@ function GetServicePrerequisites(Service: string): TStrings; procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string); +function IsProstheticsService(SvcIen: int64) : string; { Clinical Procedures Specific} @@ -354,4 +355,6 @@ Findings := Piece(x, U, 19) ; TIUResultNarrative := StrToIntDef(Piece(x, U, 20),0); + EarliestDate := StrToFloatDef(Piece(x, U, 98), 0); + //LatestDate := StrToFloatDef(Piece(x, U, 99), 0); //dropped requirement WAT //ProvDiagnosis := Piece(x, U, 23); NO!!!!! Up to 180 Characters!!!! alist.delete(0) ; @@ -668,4 +671,6 @@ Urgency := StrToIntDef(Piece(ExtractDefault(Dest, 'URGENCY'), U, 3), 0); UrgencyName := Piece(ExtractDefault(Dest, 'URGENCY'), U, 2); + EarliestDate := StrToFloatDef(Piece(ExtractDefault(Dest, 'EARLIEST'), U, 2), 0); + //LatestDate := StrToFloatDef(Piece(ExtractDefault(Dest, 'LATEST'), U, 2), 0); //dropped requirement WAT Place := Piece(ExtractDefault(Dest, 'PLACE'), U, 1); PlaceName := Piece(ExtractDefault(Dest, 'PLACE'), U, 2); @@ -734,4 +739,8 @@ Mult['10,' + IntToStr(i+1)] := NewComments.Strings[i]; end; + if EarliestDate > 0 then + Mult['11'] := 'GMRCERDT^' + FloatToStr(EarliestDate); //wat renamed v28 + {if LatestDate > 0 then + Mult['12'] := 'GMRCLATE^' + FloatToStr(LatestDate);} //dropped requirement WAT end; CallBroker; @@ -836,4 +845,9 @@ end; +function IsProstheticsService(SvcIen : int64) : string; //wat v28 + begin + Result := sCallV('ORQQCN ISPROSVC', [SvcIen]); + end; + initialization uLastOrderedIEN := 0; Index: cprs/trunk/CPRS-Chart/Consults/uConsults.pas =================================================================== --- cprs/trunk/CPRS-Chart/Consults/uConsults.pas (revision 829) +++ cprs/trunk/CPRS-Chart/Consults/uConsults.pas (revision 1679) @@ -4,5 +4,6 @@ uses - SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls; + SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls, + Contnrs, DateUtils; type @@ -38,6 +39,6 @@ ProvDxCode: string; { 30.1} RequestProcessingActivity: TStringList; { 40} - //EarliestDate: TFMDateTime; - //LatestDate: TFMDateTime; + EarliestDate: TFMDateTime; + //LatestDate: TFMDateTime; //dropped requirement WAT end ; @@ -53,6 +54,6 @@ Urgency: integer; UrgencyName: string; - //EarliestDate: TFMDateTime; - //LatestDate: TFMDateTime; + EarliestDate: TFMDateTime; + //LatestDate: TFMDateTime; //dropped requirement WAT Place: string; PlaceName: string; @@ -259,34 +260,107 @@ procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode); var - MyID, MyParent, Name, temp: string; - i: Integer; - ChildNode, tmpNode: TORTreeNode; + MyID, MyParent, Name, item: string; + i, Idx: Integer; + ParentNode, ChildNode: TORTreeNode; +// tmpNode: TORTreeNode; HasChildren: Boolean; +// AllNodes: TStringList; + ParentNodes: TStringList; +// List: TList; +// Lists: TObjectList; +// bad: boolean; + +// Former code was only filtering out half the duplicates, depending on +// how they appeared in the tree. Commented out code filters out all the duplicates, +// and still keeps the fast tree build. However, CPRS Clinical Workgroup determined +// that no duplicates should be filtered out. Code kept here in order to keep fast filter +// logic, in case duplicates are ever filtered out in the future. + +{ + procedure FilterOutDuplicates; + var + j: integer; + begin + bad := false; + if AllNodes.Find(MyID, Idx) then + begin + if AllNodes.Objects[Idx] is TORTreeNode then + begin + tmpNode := TORTreeNode(AllNodes.Objects[Idx]); + bad := tmpNode.HasAsParent(ParentNode); + if (not bad) and assigned(tmpNode.Parent) then + bad := ParentNode.HasAsParent(tmpNode.Parent); + end + else + begin + bad := False; + List := TList(AllNodes.Objects[Idx]); + for j := 0 to List.Count - 1 do + begin + tmpNode := TORTreeNode(List[j]); + bad := TORTreeNode(List[j]).HasAsParent(ParentNode); + if (not bad) and assigned(tmpNode.Parent) then + bad := ParentNode.HasAsParent(tmpNode.Parent); + if bad then break; + end; + end; + end; + end; + + procedure AddNode; + begin + if AllNodes.Find(MyID, Idx) then + begin + if AllNodes.Objects[Idx] is TORTreeNode then + begin + List := TList.Create; + Lists.Add(List); + List.Add(AllNodes.Objects[Idx]); + AllNodes.Objects[Idx] := List; + end + else + List := TList(AllNodes.Objects[Idx]); + List.Add(ChildNode); + end + else + AllNodes.AddObject(MyId, ChildNode); + end; +} + begin Tree.Items.BeginUpdate; - with SvcList do for i := 0 to Count - 1 do - begin - if Piece(Strings[i], U, 5) = 'S' then Continue; // V19.4 {rv} - //if Piece(Strings[i], U, 6) = 'S' then Continue; - MyParent := Piece(Strings[i], U, 3); - if (MyParent = Parent) then - begin - MyID := Piece(Strings[i], U, 1); - Name := Piece(Strings[i], U, 2); - temp := Strings[i]; - tmpNode := nil; - HasChildren := Piece(Strings[i], U, 4) = '+'; - if Node <> nil then if Node.HasChildren then - tmpNode := Tree.FindPieceNode(MyID, 1, U, Node); - if (tmpNode <> nil) and tmpNode.HasAsParent(Node) then - Continue - else - begin - ChildNode := TORTreeNode(Tree.Items.AddChild(Node, Name)); - ChildNode.StringData := temp; - if HasChildren then BuildServiceTree(Tree, SvcList, MyID, ChildNode); - end; - end; + ParentNodes := TStringList.Create; +// AllNodes := TStringList.Create; +// Lists := TObjectList.Create; + try + ParentNodes.Sorted := True; +// AllNodes.Sorted := True; + for i := 0 to SvcList.Count - 1 do + begin + item := SvcList[i]; + if Piece(item, U, 5) = 'S' then Continue; + MyParent := Piece(item, U, 3); + MyID := Piece(item, U, 1); + if not ParentNodes.Find(MyParent, Idx) then + ParentNode := nil + else + begin + ParentNode := TORTreeNode(ParentNodes.Objects[Idx]); +// FilterOutDuplicates; +// if bad then Continue; + end; + Name := Piece(item, U, 2); + HasChildren := Piece(item, U, 4) = '+'; + ChildNode := TORTreeNode(Tree.Items.AddChild(ParentNode, Name)); + ChildNode.StringData := item; +// AddNode; + if HasChildren then + ParentNodes.AddObject(MyID, ChildNode); end; + finally + ParentNodes.Free; +// AllNodes.Free; +// Lists.Free; + end; Tree.Items.EndUpdate; end;