Changeset 829 for cprs/trunk
- Timestamp:
- Jul 7, 2010, 4:31:10 PM (14 years ago)
- Location:
- cprs/trunk
- Files:
-
- 407 added
- 46 deleted
- 252 edited
Legend:
- Unmodified
- Added
- Removed
-
cprs/trunk/CPRS-Chart/BA/UBAConst.pas
r456 r829 30 30 MILITARY_SEXUAL_TRAUMA = 'MST'; 31 31 COMBAT_VETERAN = 'CV'; 32 SHIPBOARD_HAZARD_DEFENSE= 'SHD'; 32 33 33 34 MAX_DX = 4; -
cprs/trunk/CPRS-Chart/BA/UBACore.pas
r456 r829 112 112 end; 113 113 114 BAOrderList.Assign(holdOrderList); //assign signable orders to BAOrderList for further processing114 FastAssign(holdOrderList, BAOrderList); //assign signable orders to BAOrderList for further processing 115 115 holdOrderList.Clear; // CQ5025 116 116 117 117 //call with passList determine if LRMP 118 118 if rpcOrderRequiresDx(passList) then 119 BAOrderList.Assign(updatedBAOrderList);119 FastAssign(updatedBAOrderList, BAOrderList); 120 120 121 121 // check of all orders dx columns are flagged with N/A..... … … 165 165 end 166 166 else 167 updatedList.Assign(pList);167 FastAssign(pList, updatedList); 168 168 169 169 // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0 … … 213 213 on EListError do 214 214 begin 215 {$ifdef debug}Show Message('EListError in UBACore.IsOrderBillable()');{$endif}215 {$ifdef debug}Show508Message('EListError in UBACore.IsOrderBillable()');{$endif} 216 216 raise; 217 217 end; … … 334 334 begin 335 335 // Verify Patient is Insured 336 // OR Switch = 2 ask questions for all patients. 336 337 if rpcIsPatientInsured(pPatientDFN) then 337 338 BILLING_AWARE := TRUE; … … 407 408 on EListError do 408 409 begin 409 {$ifdef debug}Show Message('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}410 {$ifdef debug}Show508Message('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif} 410 411 raise; 411 412 end; … … 419 420 procedure rpcGetSC4Orders; 420 421 begin 422 // ****** RPC Logic returning SC/TF codes for COPAY ******** 423 // if (CIDC is ON) and (PatientInsured is True) then 424 // return SC/TF for OutPatient Meds, Labs, Prosthetics, Imaging. 425 // else 426 // return SC/TF for Outpatient Meds only. 421 427 RPCBrokerV.Param[0].PType := literal; 422 428 RPCBrokerV.Param[0].Value := Patient.DFN; … … 434 440 uDxLst.Clear; 435 441 tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]); 436 UBACore.UDxLst.Assign(tmplst);442 FastAssign(tmplst, UBACore.UDxLst); 437 443 tmplst.clear; 438 444 end; … … 511 517 function rpcIsPatientInsured(pPatientDFN: string):boolean; 512 518 begin 513 Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) = '1');519 Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) > '0'); 514 520 515 521 end; … … 552 558 on EListError do 553 559 begin 554 {$ifdef debug}Show Message('EListError in UBACore.OrdersHaveDx()');{$endif}560 {$ifdef debug}Show508Message('EListError in UBACore.OrdersHaveDx()');{$endif} 555 561 raise; 556 562 end; … … 634 640 UBAGlobals.MST := Copy(x,5,1); 635 641 UBAGlobals.HNC := Copy(x,6,1); 636 UBAGlobals.CV := Copy(x,7,1); 642 UBAGlobals.CV := Copy(x,7,1); 643 UBAGlobals.SHD := Copy(x,8,1); 637 644 end; 638 645 … … 693 700 UBAGlobals.HNC := 'C'; 694 701 702 if UBAGlobals.SHD <> 'N' then 703 if StrPos(PChar(strTFactors),PChar(SHIPBOARD_HAZARD_DEFENSE)) <> nil then 704 UBAGlobals.SHD := 'C'; 705 695 706 // Build Treatment Factor List to be passed to fOrdersSign form 696 strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV );707 strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV + SHD); 697 708 UBAGlobals.BAFlagsOUT.Add(IDX + '^' + strFlagsOut ); 698 709 end; … … 724 735 on EListError do 725 736 begin 726 {$ifdef debug}Show Message('EListError in UBACore.AddProviderPatientDaysDx()');{$endif}737 {$ifdef debug}Show508Message('EListError in UBACore.AddProviderPatientDaysDx()');{$endif} 727 738 raise; 728 739 end; … … 751 762 on EListError do 752 763 begin 753 {$ifdef debug}Show Message('EListError in UBACore.OrderRequiresSCEI()');{$endif}764 {$ifdef debug}Show508Message('EListError in UBACore.OrderRequiresSCEI()');{$endif} 754 765 raise; 755 766 end; … … 875 886 on EListError do 876 887 begin 877 {$ifdef debug}Show Message('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif}888 {$ifdef debug}Show508Message('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif} 878 889 raise; 879 890 end; … … 898 909 on EListError do 899 910 begin 900 {$ifdef debug}Show Message('EListError in UBACore.GetUnsignedOrderFlags()');{$endif}911 {$ifdef debug}Show508Message('EListError in UBACore.GetUnsignedOrderFlags()');{$endif} 901 912 raise; 902 913 end; … … 972 983 if piece(x,U,1) = COMBAT_VETERAN then 973 984 begin 974 if piece(x,U,2) = '1' then 975 UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3) 976 else 977 UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) ); 978 end; 979 end; 985 if piece(x,U,2) = '1' then 986 UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3) 987 else 988 UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) ); 989 end 990 else 991 if piece(x,U,1) = SHIPBOARD_HAZARD_DEFENSE then 992 begin 993 if piece(x,U,2) = '1' then 994 UBAGlobals.BAFactorsRec.FBAFactorSHAD := Piece(x,U,3) 995 else 996 UBAGlobals.BAFactorsRec.FBAFactorSHAD := (UBAGlobals.BAFactorsRec.FBAFactorSHAD + CRLF + Piece(x,U,3) ); 997 end; 998 end; 980 999 except 981 1000 on EListError do 982 1001 begin 983 {$ifdef debug}Show Message('EListError in UBACore.BuileTFHintRec()');{$endif}1002 {$ifdef debug}Show508Message('EListError in UBACore.BuileTFHintRec()');{$endif} 984 1003 raise; 985 1004 end; … … 1047 1066 on EListError do 1048 1067 begin 1049 {$ifdef debug}Show Message('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif}1068 {$ifdef debug}Show508Message('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif} 1050 1069 raise; 1051 1070 end; … … 1133 1152 on EListError do 1134 1153 begin 1135 {$ifdef debug}Show Message('EListError in UBACore.LoadConsultOrderRec()');{$endif}1154 {$ifdef debug}Show508Message('EListError in UBACore.LoadConsultOrderRec()');{$endif} 1136 1155 raise; 1137 1156 end; … … 1153 1172 with thisRetVal do 1154 1173 begin 1155 FBAOrderID := pOrderID;1174 FBAOrderID := pOrderID; 1156 1175 FBAEligible := pEligible; 1157 1176 FBATFactors := pTFactors; … … 1166 1185 tmpOrderList: TStringList; 1167 1186 begin 1168 orderList := TStringList.Create;1187 orderList := TStringList.Create; 1169 1188 tmpOrderList := TStringList.Create; 1170 1189 orderList.Clear; … … 1241 1260 strTFactors := pPLFactors; // value selected from problem list 1242 1261 strFlagsOut := ''; // flags updated with selected values from problem list 1243 x := strFlagsAsIs;1244 Result := '';1262 x := strFlagsAsIs; 1263 Result := ''; 1245 1264 1246 1265 UBAGlobals.SC := Copy(x,1,1); … … 1250 1269 UBAGlobals.MST := Copy(x,5,1); 1251 1270 UBAGlobals.HNC := Copy(x,6,1); 1252 UBAGlobals.CV := Copy(x,7,1); // load factors to global vars; 1271 UBAGlobals.CV := Copy(x,7,1); // load factors to global vars; 1272 UBAGlobals.SHD := Copy(x,8,1); 1253 1273 1254 1274 if UBAGlobals.SC <> 'N' then … … 1284 1304 UBAGlobals.CV := 'C'; 1285 1305 1306 if UBAGlobals.SHD <> 'N' then 1307 if StrPos(PChar(strTFactors),PChar(SHIPBOARD_HAZARD_DEFENSE)) <> nil then 1308 UBAGlobals.SHD := 'C'; 1309 1286 1310 strFlagsOut := (UBAGlobals.SC + UBAGlobals.AO + UBAGlobals.IR + 1287 1311 UBAGlobals.EC + UBAGlobals.MST + UBAGlobals.HNC + 1288 UBAGlobals.CV );1312 UBAGlobals.CV + UBAGlobals.SHD); 1289 1313 Result := strFlagsOut; 1290 1314 end; … … 1385 1409 holdList := TStringList.Create; 1386 1410 holdList.Clear; 1387 holdList.Assign(UBAGlobals.BACopiedOrderFlags);1411 FastAssign(UBAGlobals.BACopiedOrderFlags, holdList); 1388 1412 UBAGlobals.BACopiedOrderFlags.Clear; 1389 1413 for i := 0 to holdList.Count-1 do … … 1412 1436 holdList := TStringList.Create; 1413 1437 holdList.Clear; 1414 holdList.Assign(UBAGlobals.BAConsultPLFlags);1438 FastAssign(UBAGlobals.BAConsultPLFlags, holdList); 1415 1439 UBAGlobals.BAConsultPLFlags.Clear; 1416 1440 for i := 0 to holdList.Count-1 do -
cprs/trunk/CPRS-Chart/BA/UBAGlobals.pas
r456 r829 31 31 PtHNC:boolean; 32 32 PtMST:boolean; 33 PtSHAD:boolean; 33 34 constructor Create(Alist:TStringList); 34 35 function GetGMPDFN(dfn:string;name:String):string; … … 111 112 FBAFactorHNC : string; 112 113 FBAFactorCV : string; 114 FBAFactorSHAD : string; 113 115 end; 114 116 … … 131 133 CB_HNC :string; 132 134 CB_CV :string; 135 CB_SHAD :string; 133 136 end; 134 137 … … 205 208 TFactors : string; 206 209 SC,AO,IR : string; 207 MST,HNC,CV, EC: string;210 MST,HNC,CV,SHD,EC : string; 208 211 PLFactorsIndexes : TStringList; 209 212 BAHoldPrimaryDx : string; // used to verify primart dx has been changed. 210 213 BAPrimaryDxChanged: boolean; 211 // OrdersReqDxLst : TStringList; // List of selected Orders flagged collect DX Y/N212 214 NonBillableOrderList : TStringList; // contains reference to those selected orders that are non billable 213 215 OrderListSCEI : TSTringList; // OrderID Exists SCEI are required. … … 220 222 BAFWarningShown: boolean; // flag used to determine if Inactive ICD Code has been shown. 221 223 BAPersonalDX: boolean; 222 // BAConsultOrdersRequireDx: TStringList; //orderid - if orderid exists - consult order that requires dx...223 224 BADeltedOrders: TStringList; 224 225 225 226 implementation 226 227 227 uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore; 228 uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore, 229 VAUtils; 228 230 229 231 procedure RemoveOrderFromDxList(thisOrderID: string); … … 390 392 on EListError do 391 393 begin 392 {$ifdef debug}ShowM essage('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}394 {$ifdef debug}ShowMsg('EListError in UBAGlobals.PutBADxListForOrder()');{$endif} 393 395 raise; 394 396 end; … … 489 491 on EListError do 490 492 begin 491 {$ifdef debug}ShowM essage('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}493 {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif} 492 494 raise; 493 495 end; … … 506 508 on EListError do 507 509 begin 508 {$ifdef debug}ShowM essage('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}510 {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif} 509 511 raise; 510 512 end; … … 534 536 on EListError do 535 537 begin 536 {$ifdef debug}ShowM essage('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}538 {$ifdef debug}ShowMsg('EListError in UBAGlobals.GetDxNodeIndex()');{$endif} 537 539 raise; 538 540 end; … … 565 567 on EListError do 566 568 begin 567 {$ifdef debug}ShowM essage('EListError in UBAGlobals.DiagnosesMatch()');{$endif}569 {$ifdef debug}ShowMsg('EListError in UBAGlobals.DiagnosesMatch()');{$endif} 568 570 raise; 569 571 end; … … 588 590 on EListError do 589 591 begin 590 {$ifdef debug}ShowM essage('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}592 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif} 591 593 raise; 592 594 end; … … 601 603 on EListError do 602 604 begin 603 {$ifdef debug}ShowM essage('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}605 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif} 604 606 raise; 605 607 end; … … 643 645 on EListError do 644 646 begin 645 {$ifdef debug}ShowM essage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}647 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif} 646 648 raise; 647 649 end; … … 659 661 on EListError do 660 662 begin 661 {$ifdef debug}ShowM essage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}663 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif} 662 664 raise; 663 665 end; … … 704 706 on EListError do 705 707 begin 706 {$ifdef debug}ShowM essage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}708 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif} 707 709 raise; 708 710 end; … … 736 738 on EListError do 737 739 begin 738 {$ifdef debug}ShowM essage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}740 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif} 739 741 raise; 740 742 end; … … 858 860 on EListError do 859 861 begin 860 {$ifdef debug}ShowM essage('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}862 {$ifdef debug}ShowMsg('EListError in UBAGlobals.SetBADxListForOrder()');{$endif} 861 863 raise; 862 864 end; … … 890 892 on EListError do 891 893 begin 892 {$ifdef debug}ShowM essage('EListError in UBAGlobals.SecondaryDxFull()');{$endif}894 {$ifdef debug}ShowMsg('EListError in UBAGlobals.SecondaryDxFull()');{$endif} 893 895 raise; 894 896 end; … … 923 925 on EListError do 924 926 begin 925 {$ifdef debug}ShowM essage('EListError in UBAGlobals.AddSecondaryDx()');{$endif}927 {$ifdef debug}ShowMsg('EListError in UBAGlobals.AddSecondaryDx()');{$endif} 926 928 raise; 927 929 end; … … 1068 1070 7: PtHNC := (AList[i] = '1'); 1069 1071 8: PtMST := (AList[i] = '1'); 1072 9: PtSHAD := (AList[i] = '1'); 1070 1073 end; 1071 1074 end; … … 1078 1081 procedure TBAPLPt.LoadPatientParams(AList:TstringList); 1079 1082 begin 1080 AList.Assign(rpcInitPt(Patient.DFN));1083 FastAssign(rpcInitPt(Patient.DFN), AList); 1081 1084 BAPLPt := TBAPLPt.create(Alist); 1082 1085 end; … … 1111 1114 on EListError do 1112 1115 begin 1113 {$ifdef debug}ShowM essage('EListError in UBAGlobals.tempDxNodeExists()');{$endif}1116 {$ifdef debug}ShowMsg('EListError in UBAGlobals.tempDxNodeExists()');{$endif} 1114 1117 raise; 1115 1118 end; … … 1159 1162 BANurseConsultOrders := TStringList.Create; 1160 1163 BADeltedOrders := TStringList.Create; 1161 // BAConsultOrdersRequireDx := TStringList.Create;1162 1164 BAConsultDxList.Clear; 1163 1165 NonBillableOrderList.Clear; … … 1175 1177 BANurseConsultOrders.Clear; 1176 1178 BADeltedOrders.Clear; 1177 //BAConsultOrdersRequireDx.Clear; 1178 1179 1179 1180 end. 1180 1181 -
cprs/trunk/CPRS-Chart/BA/fBALocalDiagnoses.dfm
r456 r829 1 object frmBALocalDiagnoses: TfrmBALocalDiagnoses 2 Left = 192 3 Top = 61 4 Width = 620 5 Height = 544 1 inherited frmBALocalDiagnoses: TfrmBALocalDiagnoses 2 Left = 272 3 Top = 142 6 4 Caption = 'Assign Diagnoses to Order(s)' 7 Color = clBtnFace 8 Font.Charset = DEFAULT_CHARSET 9 Font.Color = clWindowText 10 Font.Height = -11 11 Font.Name = 'MS Sans Serif' 12 Font.Style = [] 13 KeyPreview = True 5 ClientHeight = 517 6 ClientWidth = 612 14 7 OldCreateOrder = False 15 8 Position = poScreenCenter … … 17 10 OnActivate = FormActivate 18 11 OnCreate = FormCreate 19 On Destroy = FormDestroy12 OnKeyPress = FormKeyPress 20 13 OnShow = FormShow 14 ExplicitWidth = 620 15 ExplicitHeight = 551 21 16 PixelsPerInch = 96 22 17 TextHeight = 13 23 object pnlTop: TPanel 18 object pnlTop: TPanel [0] 24 19 Left = 0 25 20 Top = 0 … … 33 28 96) 34 29 object lbOrders: TListBox 35 Left = 730 Left = 8 36 31 Top = 25 37 Width = 59932 Width = 602 38 33 Height = 69 39 34 Anchors = [akLeft, akTop, akRight, akBottom] 40 35 IntegralHeight = True 41 36 ItemHeight = 13 42 TabOrder = 237 TabOrder = 1 43 38 OnMouseMove = lbOrdersMouseMove 44 39 end 45 object ORStaticText1: TORStaticText46 Left = 21640 object lblPatientName: TStaticText 41 Left = 8 47 42 Top = 8 48 Width = 16949 Height = 1450 AutoSize = False51 Caption = 'Selected Orders'52 TabOrder = 153 TabStop = True54 OnEnter = ORStaticText1Enter55 OnExit = ORStaticText1Exit56 end57 object lblPatientName: TStaticText58 Left = 1159 Top = 960 43 Width = 76 61 44 Height = 17 … … 68 51 ParentFont = False 69 52 TabOrder = 0 70 TabStop = True 71 end 72 end 73 object pnlMain: TPanel 53 end 54 end 55 object pnlMain: TPanel [1] 74 56 Left = 0 75 57 Top = 96 … … 78 60 Align = alClient 79 61 TabOrder = 1 62 object lblDiagSect: TLabel 63 Left = 9 64 Top = 1 65 Width = 241 66 Height = 17 67 AutoSize = False 68 Caption = 'Diagnosis Section' 69 end 70 object lblDiagCodes: TLabel 71 Left = 253 72 Top = 1 73 Width = 353 74 Height = 17 75 AutoSize = False 76 Caption = 'Diagnosis Codes' 77 end 80 78 object lbSections: TORListBox 81 79 Left = 9 82 Top = 1 680 Top = 14 83 81 Width = 238 84 Height = 201 85 Style = lbOwnerDrawVariable 82 Height = 199 86 83 IntegralHeight = True 87 84 ItemHeight = 13 … … 95 92 LongList = False 96 93 Pieces = '3' 97 CheckEntireLine = True98 94 end 99 95 object btnOther: TButton … … 107 103 end 108 104 object lbDiagnosis: TORListBox 109 Left = 2 48105 Left = 253 110 106 Top = 16 111 107 Width = 353 … … 122 118 Pieces = '1,2,3' 123 119 end 124 object ORStaticText2: TORStaticText 125 Left = 8 126 Top = 1 127 Width = 241 128 Height = 17 129 AutoSize = False 130 BevelKind = bkFlat 131 Caption = 'Diagnosis Section' 132 TabOrder = 0 133 TabStop = True 134 OnEnter = ORStaticText1Enter 135 OnExit = ORStaticText1Exit 136 end 137 object ORStaticText3: TORStaticText 138 Left = 248 139 Top = 1 140 Width = 353 141 Height = 17 142 AutoSize = False 143 BevelKind = bkFlat 144 Caption = 'Diagnosis Codes' 145 TabOrder = 3 146 TabStop = True 147 OnEnter = ORStaticText1Enter 148 OnExit = ORStaticText1Exit 149 end 150 end 151 object pnlBottom: TORAutoPanel 120 end 121 object pnlBottom: TORAutoPanel [2] 152 122 Left = 0 153 123 Top = 355 … … 159 129 612 160 130 162) 161 object lvDxGrid: TListView162 Left = 12163 Top = 19164 Width = 445165 Height = 85166 Color = clInfoBk167 Columns = <168 item169 Caption = 'Add To PL/PD'170 Width = 85171 end172 item173 Caption = 'Primary'174 MinWidth = 65175 Width = 65176 end177 item178 Caption = 'Diagnosis for Selected Orders'179 MinWidth = 275180 Width = 290181 end>182 Ctl3D = False183 HideSelection = False184 MultiSelect = True185 ReadOnly = True186 RowSelect = True187 TabOrder = 1188 ViewStyle = vsReport189 OnClick = lvDxGridClick190 OnKeyDown = lvDxGridKeyDown191 OnKeyUp = lvDxGridKeyUp192 end193 131 object cbAddToPDList: TCheckBox 194 132 Left = 459 … … 197 135 Height = 17 198 136 Caption = 'Add to Personal Dx List' 199 TabOrder = 3137 TabOrder = 2 200 138 OnClick = cbAddToPDListClick 201 139 end … … 207 145 Anchors = [akLeft, akTop, akRight, akBottom] 208 146 Caption = 'Add To Problem List' 209 TabOrder = 2147 TabOrder = 0 210 148 OnClick = cbAddToPLClick 211 149 end … … 216 154 Height = 19 217 155 Caption = '&Primary' 218 TabOrder = 4156 TabOrder = 3 219 157 OnClick = btnPrimaryClick 220 158 end … … 225 163 Height = 19 226 164 Caption = '&Remove' 227 TabOrder = 5165 TabOrder = 4 228 166 OnClick = btnRemoveClick 229 167 end … … 234 172 Height = 18 235 173 Caption = '&Select All' 236 TabOrder = 6174 TabOrder = 5 237 175 OnClick = btnSelectAllClick 238 176 end … … 243 181 Height = 21 244 182 Caption = '&OK' 245 TabOrder = 7183 TabOrder = 6 246 184 OnClick = buOKClick 247 185 end … … 252 190 Height = 21 253 191 Caption = '&Cancel' 254 TabOrder = 8192 TabOrder = 7 255 193 OnClick = buCancelClick 256 194 end 257 object ORStaticText4: TORStaticText 258 Left = 14 259 Top = 3 260 Width = 219 261 Height = 14 262 AutoSize = False 195 object gbProvDiag: TGroupBox 196 Left = 8 197 Top = 0 198 Width = 449 199 Height = 105 263 200 Caption = 'Provisional Diagnosis' 264 TabOrder = 0 265 TabStop = True 266 OnEnter = ORStaticText1Enter 267 OnExit = ORStaticText1Exit 268 end 201 TabOrder = 1 202 object lvDxGrid: TListView 203 Left = 2 204 Top = 15 205 Width = 445 206 Height = 88 207 Align = alClient 208 Color = clInfoBk 209 Columns = < 210 item 211 Caption = 'Add To PL/PD' 212 Width = 85 213 end 214 item 215 Caption = 'Primary' 216 MinWidth = 65 217 Width = 65 218 end 219 item 220 Caption = 'Diagnosis for Selected Orders' 221 MinWidth = 275 222 Width = 290 223 end> 224 Ctl3D = False 225 HideSelection = False 226 MultiSelect = True 227 ReadOnly = True 228 RowSelect = True 229 TabOrder = 0 230 ViewStyle = vsReport 231 OnClick = lvDxGridClick 232 OnKeyDown = lvDxGridKeyDown 233 OnKeyUp = lvDxGridKeyUp 234 end 235 end 236 end 237 inherited amgrMain: TVA508AccessibilityManager 238 Data = ( 239 ( 240 'Component = pnlTop' 241 'Status = stsDefault') 242 ( 243 'Component = lbOrders' 244 'Status = stsDefault') 245 ( 246 'Component = lblPatientName' 247 'Status = stsDefault') 248 ( 249 'Component = pnlMain' 250 'Status = stsDefault') 251 ( 252 'Component = lbSections' 253 'Label = lblDiagSect' 254 'Status = stsOK') 255 ( 256 'Component = btnOther' 257 'Status = stsDefault') 258 ( 259 'Component = lbDiagnosis' 260 'Label = lblDiagCodes' 261 'Status = stsOK') 262 ( 263 'Component = pnlBottom' 264 'Status = stsDefault') 265 ( 266 'Component = cbAddToPDList' 267 'Status = stsDefault') 268 ( 269 'Component = cbAddToPL' 270 'Status = stsDefault') 271 ( 272 'Component = btnPrimary' 273 'Status = stsDefault') 274 ( 275 'Component = btnRemove' 276 'Status = stsDefault') 277 ( 278 'Component = btnSelectAll' 279 'Status = stsDefault') 280 ( 281 'Component = buOK' 282 'Status = stsDefault') 283 ( 284 'Component = buCancel' 285 'Status = stsDefault') 286 ( 287 'Component = gbProvDiag' 288 'Status = stsDefault') 289 ( 290 'Component = lvDxGrid' 291 'Status = stsDefault') 292 ( 293 'Component = frmBALocalDiagnoses' 294 'Status = stsDefault')) 269 295 end 270 296 end -
cprs/trunk/CPRS-Chart/BA/fBALocalDiagnoses.pas
r456 r829 7 7 Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls,fPCELex, uConsults, ORFn, 8 8 rPCE,DBCtrls, DB, DBClient, uPCE, fEncounterFrame, ComCtrls, Grids, UBAGlobals, 9 Buttons, Menus, UBACore, UCore ;9 Buttons, Menus, UBACore, UCore, VA508AccessibilityManager; 10 10 11 11 type … … 23 23 lbSections: TORListBox; 24 24 pnlBottom: TORAutoPanel; 25 lvDxGrid: TListView;26 25 cbAddToPDList: TCheckBox; 27 26 cbAddToPL: TCheckBox; … … 33 32 btnOther: TButton; 34 33 lbDiagnosis: TORListBox; 35 ORStaticText1: TORStaticText; 36 ORStaticText2: TORStaticText; 37 ORStaticText3: TORStaticText; 38 ORStaticText4: TORStaticText; 34 lblDiagSect: TLabel; 35 lblDiagCodes: TLabel; 39 36 lblPatientName: TStaticText; 37 gbProvDiag: TGroupBox; 38 lvDxGrid: TListView; 40 39 procedure buOKClick(Sender: TObject); 41 40 procedure buCancelClick(Sender: TObject); … … 65 64 procedure lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X, 66 65 Y: Integer); 67 procedure ORStaticText1Enter(Sender: TObject); 68 procedure ORStaticText1Exit(Sender: TObject); 69 procedure ORStaticText3Enter(Sender: TObject); 70 procedure ORStaticText3Exit(Sender: TObject); 66 procedure FormKeyPress(Sender: TObject; var Key: Char); 71 67 72 68 private … … 105 101 function PersonalListDxFound(pDxCode:string):boolean; 106 102 procedure ReSetCheckBoxStatus(pDxCode:String); 103 procedure DeleteSelectedDx; 104 function IsCtrlDown: boolean; 107 105 108 106 public … … 110 108 procedure Enter(theCaller: smallint; pOrderIDList: TStringList); 111 109 procedure LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string); 110 112 111 end; 113 112 … … 137 136 138 137 uses rCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA, 139 uAccessibleStringGrid,ORNet, fProbs, fOrdersSign, UBAConst,140 UBAMessages, fReview, uSignItems, fODConsult, fFrame ;138 ORNet, fProbs, fOrdersSign, UBAConst, 139 UBAMessages, fReview, uSignItems, fODConsult, fFrame, VAUtils; 141 140 142 141 var … … 176 175 end; 177 176 177 procedure TfrmBALocalDiagnoses.FormKeyPress(Sender: TObject; var Key: Char); 178 begin 179 inherited; 180 if frmBALocalDiagnoses.IsCtrlDown then 181 begin 182 if ( Key = #10 ) then 183 frmBALocalDiagnoses.buOK.Click; 184 end; 185 186 end; 187 178 188 procedure TfrmBALocalDiagnoses.ListDiagnosisSections(Dest: TStrings); 179 189 { return section names in format: ListIndex^SectionName (sections begin with '^') } … … 195 205 ECFDiagnosis := TStringList.Create; 196 206 uProblems := TStringList.Create; 197 lblPatientName.Caption := Patient.Name ;207 lblPatientName.Caption := Patient.Name + ' Selected Orders'; 198 208 DeselectGridItems; 199 209 … … 501 511 begin 502 512 a := Piece(BADiagnosis[j], U, 2) + U + Piece(BADiagnosis[j], U, 1) + U + ' ' + Piece(BADiagnosis[j], U, 3) ; 503 if a = '' then showmessage('found nothing');513 if a = '' then ShowMsg('found nothing'); 504 514 lbDiagnosis.Items.Add(a); 505 515 end; … … 578 588 inherited; 579 589 deleteDX := True; 580 lvDxGrid.DeleteSelected;590 frmBALocalDiagnoses.DeleteSelectedDX; 581 591 ClearAndDisableCBoxes; 582 592 DeselectGridItems; 583 593 EnsurePrimary; 584 594 deleteDX := False; 585 595 // if all dx's removed, clear out displaycode 586 596 if lvDxGrid.items.Count = 0 then FODConsult.displayDXCode := ''; 587 597 end; … … 627 637 begin 628 638 DeselectGridItems; 629 ShowM essage(BA_MAX_DX); //** max 4 diagnoses per order639 ShowMsg(BA_MAX_DX); //** max 4 diagnoses per order 630 640 end; 631 641 end; … … 812 822 NewList.Clear; 813 823 // ** Add Diagnosis to Problem List if flagged with 'Add' in First Col. 814 with lvDxGrid do824 with frmBALocalDiagnoses.lvDxGrid do 815 825 begin 816 826 for i := 0 to Items.Count-1 do … … 861 871 i : integer; 862 872 tempStr1,tempStr2, tempStr3: string; 863 tempFactor1 ,x: string;873 tempFactor1: string; 864 874 tempStrList: TStringList; 865 875 begin … … 877 887 tempFactor1 := ''; 878 888 879 if lvDxGrid.Items.Count > 0 then880 with lvDxGrid do889 if frmBALocalDiagnoses.lvDxGrid.Items.Count > 0 then 890 with frmBALocalDiagnoses.lvDxGrid do 881 891 begin 882 892 for i := 0 to Items.Count-1 do 883 893 begin 884 x := lvDxGrid.Items[i].Subitems[0];885 x := lvDxGrid.Items[i].Subitems[1];886 x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1];894 // x := lvDxGrid.Items[i].Subitems[0]; 895 // x := lvDxGrid.Items[i].Subitems[1]; 896 // x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]; 887 897 tempStrList.Add(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]); 888 898 end; … … 1121 1131 on EListError do 1122 1132 begin 1123 {$ifdef debug}Show Message('EListError in frmBALocalDiagnoses.ListSelectedOrders()');{$endif}1133 {$ifdef debug}Show508Message('EListError in frmBALocalDiagnoses.ListSelectedOrders()');{$endif} 1124 1134 raise; 1125 1135 end; … … 1148 1158 on EListError do 1149 1159 begin 1150 {$ifdef debug}Show Message('EListError in frmBALocalDiagnoses.AddDiagnosisToPersonalDiagnosesListClick()');{$endif}1160 {$ifdef debug}Show508Message('EListError in frmBALocalDiagnoses.AddDiagnosisToPersonalDiagnosesListClick()');{$endif} 1151 1161 raise; 1152 1162 end; … … 1156 1166 if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then 1157 1167 begin 1158 ShowM essage(UBAMessages.BA_PERSONAL_LIST_UPDATED);1168 ShowMsg(UBAMessages.BA_PERSONAL_LIST_UPDATED); 1159 1169 LoadEncounterForm; 1160 1170 Refresh; … … 1179 1189 if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then 1180 1190 begin 1181 ShowM essage(UBAMessages.BA_PERSONAL_LIST_UPDATED);1191 ShowMsg(UBAMessages.BA_PERSONAL_LIST_UPDATED); 1182 1192 LoadEncounterForm; 1183 1193 Refresh; … … 1267 1277 (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as 1268 1278 TListBox).Items[Index]); {** display the text } 1279 1269 1280 end; 1270 1281 … … 1526 1537 end; 1527 1538 1528 procedure TfrmBALocalDiagnoses.ORStaticText1Enter(Sender: TObject);1529 begin1530 inherited;1531 (Sender as TORStaticText).Font.Style := [fsBold];1532 end;1533 1534 procedure TfrmBALocalDiagnoses.ORStaticText1Exit(Sender: TObject);1535 begin1536 inherited;1537 (Sender as TORStaticText).Font.Style := [];1538 end;1539 1540 procedure TfrmBALocalDiagnoses.ORStaticText3Enter(Sender: TObject);1541 begin1542 inherited;1543 (Sender as TORStaticText).Font.Style := [fsBold];1544 end;1545 1546 procedure TfrmBALocalDiagnoses.ORStaticText3Exit(Sender: TObject);1547 begin1548 inherited;1549 (Sender as TORStaticText).Font.Style := [];1550 end;1551 1552 1539 procedure TfrmBALocalDiagnoses.ResetCheckBoxStatus(pDxCode:string); 1553 1540 begin … … 1556 1543 if Not PersonalListDxFound(pDxCode) then 1557 1544 cbAddToPDList.Enabled := True; 1558 1559 1560 end; 1545 end; 1546 1547 procedure TfrmBALocalDiagnoses.DeleteSelectedDx; 1548 var 1549 I: Integer; 1550 begin 1551 frmBALocalDiagnoses.lvDxGrid.Items.BeginUpdate; 1552 try 1553 for I := frmBALocalDiagnoses.lvDxGrid.Items.Count - 1 downto 0 do 1554 if frmBALocalDiagnoses.lvDxGrid.Items[I].Selected then 1555 frmBALocalDiagnoses.lvdxGrid.Items[I].delete; 1556 finally 1557 lvDxGrid.Items.EndUpdate; 1558 end; 1559 1560 end; 1561 1562 function TfrmBALocalDiagnoses.IsCtrlDown: boolean; 1563 var 1564 State: TKeyboardState; 1565 begin { isCtrlDown } 1566 GetKeyboardState(State); 1567 Result := ((State[VK_CONTROL] and 128)<>0); // Ctrl-button 1568 end; { isCtrlDown } 1569 1570 1561 1571 1562 1572 -
cprs/trunk/CPRS-Chart/BA/fBAOptionsDiagnoses.dfm
r456 r829 2 2 Left = 231 3 3 Top = 183 4 Width = 7475 Height = 5576 4 Caption = 'Personal Diagnoses List' 5 ClientHeight = 530 6 ClientWidth = 739 7 7 Constraints.MinHeight = 100 8 8 Constraints.MinWidth = 200 … … 10 10 OnCreate = FormCreate 11 11 OnShow = FormShow 12 ExplicitWidth = 747 13 ExplicitHeight = 557 12 14 PixelsPerInch = 96 13 15 TextHeight = 13 14 object Panel1: TPanel 16 object Panel1: TPanel [0] 15 17 Left = 0 16 18 Top = 0 … … 34 36 Width = -3 35 37 Height = 463 36 Cursor = crHSplit37 38 end 38 39 object Splitter2: TSplitter … … 41 42 Width = 7 42 43 Height = 463 43 Cursor = crHSplit44 44 end 45 45 object Splitter3: TSplitter … … 48 48 Width = 1 49 49 Height = 463 50 Cursor = crHSplit51 50 end 52 51 object Splitter5: TSplitter … … 55 54 Width = 2 56 55 Height = 463 57 Cursor = crHSplit58 56 end 59 57 object pnlBottom: TPanel … … 142 140 Width = 168 143 141 Height = 17 144 DragReorder = False145 142 Sections = < 146 143 item … … 190 187 Width = 201 191 188 Height = 17 192 DragReorder = False193 189 Sections = < 194 190 item … … 233 229 Width = 257 234 230 Height = 17 235 DragReorder = False236 231 Sections = < 237 232 item … … 310 305 end 311 306 end 307 inherited amgrMain: TVA508AccessibilityManager 308 Data = ( 309 ( 310 'Component = Panel1' 311 'Status = stsDefault') 312 ( 313 'Component = Panel2' 314 'Status = stsDefault') 315 ( 316 'Component = pnlBottom' 317 'Status = stsDefault') 318 ( 319 'Component = btnOther' 320 'Status = stsDefault') 321 ( 322 'Component = btnOK' 323 'Status = stsDefault') 324 ( 325 'Component = Button1' 326 'Status = stsDefault') 327 ( 328 'Component = Panel3' 329 'Status = stsDefault') 330 ( 331 'Component = lbSections' 332 'Status = stsDefault') 333 ( 334 'Component = hdrCntlDxSections' 335 'Status = stsDefault') 336 ( 337 'Component = Panel4' 338 'Status = stsDefault') 339 ( 340 'Component = lbDiagnosis' 341 'Status = stsDefault') 342 ( 343 'Component = hdrCntlDxAdd' 344 'Status = stsDefault') 345 ( 346 'Component = Panel5' 347 'Status = stsDefault') 348 ( 349 'Component = lbPersonalDx' 350 'Status = stsDefault') 351 ( 352 'Component = hdrCntlDx' 353 'Status = stsDefault') 354 ( 355 'Component = pnlTop' 356 'Status = stsDefault') 357 ( 358 'Component = StaticText3' 359 'Status = stsDefault') 360 ( 361 'Component = Panel7' 362 'Status = stsDefault') 363 ( 364 'Component = btnAdd' 365 'Status = stsDefault') 366 ( 367 'Component = btnDelete' 368 'Status = stsDefault') 369 ( 370 'Component = frmBAOptionsDiagnoses' 371 'Status = stsDefault')) 372 end 312 373 end -
cprs/trunk/CPRS-Chart/BA/fBAOptionsDiagnoses.pas
r456 r829 7 7 Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls, ORFn, UCore, RCore, ORNet, 8 8 UBAGlobals, fPCELex, rPCE, Buttons, UBACore, UBAMessages, UBAConst, 9 ComCtrls ;9 ComCtrls, VA508AccessibilityManager; 10 10 11 11 type -
cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.dfm
r456 r829 1 objectfrmConsMedRslt: TfrmConsMedRslt1 inherited frmConsMedRslt: TfrmConsMedRslt 2 2 Left = 468 3 3 Top = 172 … … 6 6 ClientHeight = 242 7 7 ClientWidth = 505 8 Color = clBtnFace9 Font.Charset = DEFAULT_CHARSET10 Font.Color = clWindowText11 Font.Height = -1112 Font.Name = 'MS Sans Serif'13 Font.Style = []14 OldCreateOrder = True15 8 Position = poScreenCenter 16 OnDestroy = FormDestroy 9 ExplicitWidth = 320 10 ExplicitHeight = 240 17 11 PixelsPerInch = 96 18 12 TextHeight = 13 19 object pnlBase: TORAutoPanel 13 object pnlBase: TORAutoPanel [0] 20 14 Left = 0 21 15 Top = 0 … … 178 172 TabOrder = 3 179 173 OnNeedData = NewPersonNeedData 180 end 174 CharsNeedMatch = 1 175 end 176 end 177 inherited amgrMain: TVA508AccessibilityManager 178 Data = ( 179 ( 180 'Component = pnlBase' 181 'Status = stsDefault') 182 ( 183 'Component = cmdOK' 184 'Status = stsDefault') 185 ( 186 'Component = cmdCancel' 187 'Status = stsDefault') 188 ( 189 'Component = lstMedResults' 190 'Status = stsDefault') 191 ( 192 'Component = cmdDetails' 193 'Status = stsDefault') 194 ( 195 'Component = ckAlert' 196 'Status = stsDefault') 197 ( 198 'Component = calDateofAction' 199 'Status = stsDefault') 200 ( 201 'Component = cboPerson' 202 'Status = stsDefault') 203 ( 204 'Component = frmConsMedRslt' 205 'Status = stsDefault')) 181 206 end 182 207 end -
cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.pas
r456 r829 4 4 5 5 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 6 Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox; 6 Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox, 7 VA508AccessibilityManager; 7 8 8 9 type … … 82 83 if MedResult.Action = 'ATTACH' then 83 84 begin 84 lstMedResults.Items.Assign(GetAssignableMedResults(ConsultIEN));85 FastAssign(GetAssignableMedResults(ConsultIEN), lstMedResults.Items); 85 86 ckAlert.Visible := True; 86 87 end 87 88 else if MedResult.Action = 'REMOVE' then 88 89 begin 89 lstMedResults.Items.Assign(GetRemovableMedResults(ConsultIEN));90 FastAssign(GetRemovableMedResults(ConsultIEN), lstMedResults.Items); 90 91 ckAlert.Visible := False; 91 92 end; … … 134 135 var 135 136 x: string; 137 //MsgString, HasImages: string; 136 138 begin 137 139 inherited; 138 140 if lstMedResults.ItemIndex = -1 then exit; 139 141 x := Piece(Piece(Piece(lstMedResults.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstMedResults.ItemID, ';', 1); 142 // --------------------------------------------------------------- 143 // Don't do this until MED API is changed for new/unassigned results, or false '0' will be broadcast 144 (* MsgString := 'MED^' + x; 145 HasImages := BOOLCHAR[StrToIntDef(Piece(x, U, 5), 0) > 0]; 146 SetPiece(HasImages, U, 10, HasImages); 147 NotifyOtherApps(NAE_REPORT, MsgString);*) 148 // --------------------------------------------------------------- 140 149 NotifyOtherApps(NAE_REPORT, 'MED^' + x); 141 150 if(not assigned(FShowDetails)) then -
cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.dfm
r456 r829 1 objectfrm513Print: Tfrm513Print1 inherited frm513Print: Tfrm513Print 2 2 Left = 116 3 3 Top = 375 4 AutoScroll = False5 4 Caption = 'Print SF 513' 6 ClientHeight = 308 7 ClientWidth = 427 8 Color = clBtnFace 9 Font.Charset = DEFAULT_CHARSET 10 Font.Color = clWindowText 11 Font.Height = -11 12 Font.Name = 'MS Sans Serif' 13 Font.Style = [] 14 OldCreateOrder = True 5 ClientHeight = 306 15 6 Position = poScreenCenter 16 OnCreate = FormCreate 17 OnDestroy = FormDestroy 7 ExplicitHeight = 340 18 8 PixelsPerInch = 96 19 9 TextHeight = 13 20 object lblPrintTo: TLabel 10 object lblPrintTo: TLabel [0] 21 11 Left = 7 22 12 Top = 265 … … 24 14 Height = 13 25 15 end 26 object lblConsultTitle: TMemo 16 object lblConsultTitle: TMemo [1] 27 17 Left = 10 28 18 Top = 8 … … 36 26 TabOrder = 0 37 27 end 38 object grpChooseCopy: TGroupBox 28 object grpChooseCopy: TGroupBox [2] 39 29 Left = 321 40 30 Top = 4 … … 64 54 end 65 55 end 66 object grpDevice: TGroupBox 56 object grpDevice: TGroupBox [3] 67 57 Left = 8 68 58 Top = 69 … … 131 121 OnChange = cboDeviceChange 132 122 OnNeedData = cboDeviceNeedData 123 CharsNeedMatch = 1 133 124 end 134 125 end 135 object cmdOK: TButton 126 object cmdOK: TButton [4] 136 127 Left = 267 137 128 Top = 272 … … 143 134 OnClick = cmdOKClick 144 135 end 145 object cmdCancel: TButton 136 object cmdCancel: TButton [5] 146 137 Left = 347 147 138 Top = 272 … … 153 144 OnClick = cmdCancelClick 154 145 end 155 object chkDefault: TCheckBox 146 object chkDefault: TCheckBox [6] 156 147 Left = 7 157 148 Top = 288 … … 161 152 TabOrder = 3 162 153 end 154 inherited amgrMain: TVA508AccessibilityManager 155 Data = ( 156 ( 157 'Component = lblConsultTitle' 158 'Status = stsDefault') 159 ( 160 'Component = grpChooseCopy' 161 'Status = stsDefault') 162 ( 163 'Component = radChartCopy' 164 'Status = stsDefault') 165 ( 166 'Component = radWorkCopy' 167 'Status = stsDefault') 168 ( 169 'Component = grpDevice' 170 'Status = stsDefault') 171 ( 172 'Component = txtRightMargin' 173 'Status = stsDefault') 174 ( 175 'Component = txtPageLength' 176 'Status = stsDefault') 177 ( 178 'Component = cboDevice' 179 'Status = stsDefault') 180 ( 181 'Component = cmdOK' 182 'Status = stsDefault') 183 ( 184 'Component = cmdCancel' 185 'Status = stsDefault') 186 ( 187 'Component = chkDefault' 188 'Status = stsDefault') 189 ( 190 'Component = frm513Print' 191 'Status = stsDefault')) 192 end 163 193 object dlgWinPrinter: TPrintDialog 164 194 Left = 268 -
cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls; 7 fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls, 8 VA508AccessibilityManager, uReports; 8 9 9 10 type … … 26 27 procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String; 27 28 Direction, InsertAt: Integer); 28 procedure FormCreate(Sender: TObject);29 29 procedure cboDeviceChange(Sender: TObject); 30 30 procedure radChartCopyClick(Sender: TObject); … … 32 32 procedure cmdOKClick(Sender: TObject); 33 33 procedure cmdCancelClick(Sender: TObject); 34 procedure FormDestroy(Sender: TObject); 34 35 35 private 36 36 { Private declarations } … … 98 98 end; 99 99 100 procedure Tfrm513Print.FormCreate(Sender: TObject);101 begin102 inherited;103 FReportText := TRichEdit.Create(Self);104 with FReportText do105 begin106 Parent := Self;107 Visible := False;108 Width := 600;109 end;110 end;111 112 100 procedure Tfrm513Print.DisplaySelectDevice; 113 101 begin … … 157 145 begin 158 146 inherited; 147 FReportText := CreateReportTextComponent(Self); 159 148 RemoteSiteID := ''; 160 149 RemoteQuery := ''; … … 169 158 if dlgWinPrinter.Execute then with FReportText do 170 159 begin 171 FReportText.Lines.Assign(GetFormattedSF513(FConsult, ChartCopy));160 QuickCopy(GetFormattedSF513(FConsult, ChartCopy), FReportText); 172 161 PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg); 173 162 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); … … 183 172 if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1)); 184 173 User.CurrentPrinter := cboDevice.ItemID; 174 FReportText.Free; 185 175 Close; 186 176 end; … … 192 182 end; 193 183 194 procedure Tfrm513Print.FormDestroy(Sender: TObject);195 begin196 FReportText.Free;197 inherited;198 end;199 200 184 end. -
cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm
r456 r829 1 objectfrmConsultAction: TfrmConsultAction1 inherited frmConsultAction: TfrmConsultAction 2 2 Left = 277 3 3 Top = 217 4 Width = 6005 Height = 4066 4 BorderIcons = [] 7 5 Caption = 'frmConsultAction' 8 Color = clBtnFace 6 ClientHeight = 379 7 ClientWidth = 592 9 8 Constraints.MinHeight = 406 10 9 Constraints.MinWidth = 600 11 Font.Charset = DEFAULT_CHARSET12 Font.Color = clWindowText13 Font.Height = -1114 Font.Name = 'MS Sans Serif'15 Font.Style = []16 10 OldCreateOrder = True 17 11 Position = poScreenCenter 18 12 PixelsPerInch = 96 19 13 TextHeight = 13 20 object pnlBase: TPanel 14 object pnlBase: TPanel [0] 21 15 Left = 0 22 16 Top = 0 … … 360 354 end 361 355 end 356 inherited amgrMain: TVA508AccessibilityManager 357 Data = ( 358 ( 359 'Component = pnlBase' 360 'Status = stsDefault') 361 ( 362 'Component = pnlForward' 363 'Status = stsDefault') 364 ( 365 'Component = Label1' 366 'Status = stsDefault') 367 ( 368 'Component = cboAttentionOf' 369 'Status = stsDefault') 370 ( 371 'Component = cboUrgency' 372 'Status = stsDefault') 373 ( 374 'Component = treService' 375 'Status = stsDefault') 376 ( 377 'Component = cboService' 378 'Status = stsDefault') 379 ( 380 'Component = pnlOther' 381 'Status = stsDefault') 382 ( 383 'Component = pnlSigFind' 384 'Status = stsDefault') 385 ( 386 'Component = grpSigFindings' 387 'Status = stsDefault') 388 ( 389 'Component = pnlComments' 390 'Status = stsDefault') 391 ( 392 'Component = memComments' 393 'Status = stsDefault') 394 ( 395 'Component = pnlAlert' 396 'Status = stsDefault') 397 ( 398 'Component = lblAutoAlerts' 399 'Status = stsDefault') 400 ( 401 'Component = ckAlert' 402 'Status = stsDefault') 403 ( 404 'Component = pnlAllActions' 405 'Status = stsDefault') 406 ( 407 'Component = calDateofAction' 408 'Status = stsDefault') 409 ( 410 'Component = cmdOK' 411 'Status = stsDefault') 412 ( 413 'Component = cmdCancel' 414 'Status = stsDefault') 415 ( 416 'Component = cboPerson' 417 'Status = stsDefault') 418 ( 419 'Component = frmConsultAction' 420 'Status = stsDefault')) 421 end 362 422 end -
cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN, 7 StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm; 7 StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmConsultAction = class(T Form)11 TfrmConsultAction = class(TfrmBase508Form) 11 12 lblActionBy: TOROffsetLabel; 12 13 calDateofAction: TORDateBox; … … 160 161 begin 161 162 OrdItmIEN := GetOrderableIEN(IntToStr(ConsultRec.ORFileNumber)); 162 SvcList.Assign(GetProcedureServices(OrdItmIEN));163 // SvcList.Assign(GetProcedureServices(ProcIEN)); RPC expects pointer to 101.43, NOT 123.3 (RV)163 FastAssign(GetProcedureServices(OrdItmIEN), SvcList); 164 //FastAssign(GetProcedureServices(ProcIEN), SvcList); RPC expects pointer to 101.43, NOT 123.3 (RV) 164 165 i := SvcList.IndexOf(IntToStr(ConsultRec.ToService) + U + Trim(ExternalName(ConsultRec.ToService, 123.5))); 165 166 if i > -1 then SvcList.Delete(i); … … 167 168 end 168 169 else 169 SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN)); {RV}170 FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN), SvcList); {RV} 170 171 if (IsProcedure and (SvcList.Count <= 0)) then 171 172 begin … … 204 205 FToService := cboService.ItemIEN; 205 206 cboAttentionOf.InitLongList('') ; 206 with cboUrgency do 207 begin 208 Items.Assign(SubsetofUrgencies(ConsultRec.IEN)) ;207 with cboUrgency do 208 begin 209 FastAssign(SubsetofUrgencies(ConsultRec.IEN), cboUrgency.Items) ; 209 210 MixedCaseList(Items) ; 210 211 SelectByIEN(ConsultRec.Urgency); … … 562 563 end; 563 564 564 procedure TfrmConsultAction.ShowAutoAlertText; 565 (*procedure TfrmConsultAction.ShowAutoAlertText; **** SEE BELOW FOR REPLACEMENT - v27.9 Phelps/Vertigan 565 566 const 566 567 TX_ALERT1 = 'An alert will automatically be sent to '; … … 588 589 end; 589 590 lblAutoAlerts.Caption := x; 590 end; 591 end;*) 592 593 procedure TfrmConsultAction.ShowAutoAlertText; 594 const 595 TX_ALERT1 = 'An alert will automatically be sent to '; 596 TX_ALERT_PROVIDER = 'the ordering provider'; 597 TX_ALERT_SVC_USERS = 'notification recipients for this service.'; 598 TX_ALERT_NOBODY = 'No automatic alerts will be sent.'; // this should be rare to never 599 var 600 x: string; 601 begin 602 case FUserLevel of 603 UL_NONE, UL_REVIEW: 604 begin 605 if FUserIsRequester then 606 x := TX_ALERT1 + TX_ALERT_SVC_USERS 607 else 608 x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS; 609 end; 610 UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN: 611 begin 612 if FUserIsRequester then 613 //x := TX_ALERT_NOBODY Replace with following line 614 x := TX_ALERT1 + TX_ALERT_SVC_USERS 615 else 616 x := TX_ALERT1 + TX_ALERT_PROVIDER + '.'; 617 end; 618 UL_UNRESTRICTED: 619 begin 620 if FUserIsRequester then 621 x := TX_ALERT1 + TX_ALERT_SVC_USERS 622 else 623 x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS; 624 end; 625 end; 626 lblAutoAlerts.Caption := x; 627 end; 628 591 629 592 630 initialization -
cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.dfm
r456 r829 1 objectfrmConsultAlertsTo: TfrmConsultAlertsTo1 inherited frmConsultAlertsTo: TfrmConsultAlertsTo 2 2 Left = 297 3 3 Top = 206 … … 5 5 Caption = 'Send Alert' 6 6 ClientHeight = 262 7 ClientWidth = 358 8 Color = clBtnFace 9 Font.Charset = DEFAULT_CHARSET 10 Font.Color = clWindowText 11 Font.Height = -11 12 Font.Name = 'MS Sans Serif' 13 Font.Style = [] 7 ClientWidth = 371 14 8 OldCreateOrder = True 15 9 Position = poScreenCenter 16 10 PixelsPerInch = 96 17 11 TextHeight = 13 18 object pnlBase: TORAutoPanel 12 object pnlBase: TORAutoPanel [0] 19 13 Left = 0 20 14 Top = 0 21 Width = 3 5815 Width = 371 22 16 Height = 262 23 17 Align = alClient 24 18 BevelOuter = bvNone 25 19 TabOrder = 0 20 ExplicitWidth = 358 26 21 object SrcLabel: TLabel 27 22 Left = 12 … … 32 27 end 33 28 object DstLabel: TLabel 34 Left = 19629 Left = 217 35 30 Top = 14 36 31 Width = 132 … … 45 40 Caption = 'OK' 46 41 ModalResult = 1 47 TabOrder = 242 TabOrder = 4 48 43 OnClick = cmdOKClick 49 44 end … … 56 51 Caption = 'Cancel' 57 52 ModalResult = 2 58 TabOrder = 353 TabOrder = 5 59 54 OnClick = cmdCancelClick 60 55 end … … 83 78 OnMouseClick = cboSrcListMouseClick 84 79 OnNeedData = cboSrcListNeedData 80 CharsNeedMatch = 1 85 81 end 86 82 object DstList: TORListBox 87 Left = 19683 Left = 217 88 84 Top = 30 89 85 Width = 144 … … 93 89 ParentShowHint = False 94 90 ShowHint = True 95 TabOrder = 191 TabOrder = 2 96 92 OnClick = DstListClick 97 93 Caption = 'Currently selected recipients' … … 100 96 Pieces = '2' 101 97 end 98 object btnAdd: TButton 99 Left = 160 100 Top = 109 101 Width = 51 102 Height = 25 103 Caption = 'Add' 104 TabOrder = 1 105 OnClick = cboSrcListMouseClick 106 end 107 object btnRemove: TButton 108 Left = 160 109 Top = 140 110 Width = 51 111 Height = 25 112 Caption = 'Remove' 113 TabOrder = 3 114 OnClick = DstListClick 115 end 116 end 117 inherited amgrMain: TVA508AccessibilityManager 118 Data = ( 119 ( 120 'Component = pnlBase' 121 'Status = stsDefault') 122 ( 123 'Component = cmdOK' 124 'Status = stsDefault') 125 ( 126 'Component = cmdCancel' 127 'Status = stsDefault') 128 ( 129 'Component = cboSrcList' 130 'Status = stsDefault') 131 ( 132 'Component = DstList' 133 'Status = stsDefault') 134 ( 135 'Component = btnAdd' 136 'Status = stsDefault') 137 ( 138 'Component = btnRemove' 139 'Status = stsDefault') 140 ( 141 'Component = frmConsultAlertsTo' 142 'Status = stsDefault')) 102 143 end 103 144 end -
cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.pas
r456 r829 4 4 5 5 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 6 Buttons, ORCtrls, ORfn, ExtCtrls ;6 Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager; 7 7 8 8 type 9 TfrmConsultAlertsTo = class(T Form)9 TfrmConsultAlertsTo = class(TfrmBase508Form) 10 10 cmdOK: TButton; 11 11 cmdCancel: TButton; … … 15 15 DstLabel: TLabel; 16 16 pnlBase: TORAutoPanel; 17 btnAdd: TButton; 18 btnRemove: TButton; 17 19 procedure cboSrcListNeedData(Sender: TObject; const StartFrom: String; 18 20 Direction, InsertAt: Integer); -
cprs/trunk/CPRS-Chart/Consults/fConsultBD.dfm
r456 r829 1 objectfrmConsultsByDate: TfrmConsultsByDate1 inherited frmConsultsByDate: TfrmConsultsByDate 2 2 Left = 372 3 3 Top = 217 4 Width = 2595 Height = 1786 4 BorderIcons = [] 7 5 Caption = 'List Consults by Date Range' 8 Color = clBtnFace 9 Font.Charset = DEFAULT_CHARSET 10 Font.Color = clWindowText 11 Font.Height = -11 12 Font.Name = 'MS Sans Serif' 13 Font.Style = [] 6 ClientHeight = 151 7 ClientWidth = 251 14 8 OldCreateOrder = True 15 9 Position = poScreenCenter 10 ExplicitWidth = 259 11 ExplicitHeight = 178 16 12 PixelsPerInch = 96 17 13 TextHeight = 13 18 object pnlBase: TORAutoPanel 14 object pnlBase: TORAutoPanel [0] 19 15 Left = 0 20 16 Top = 0 … … 90 86 end 91 87 end 88 inherited amgrMain: TVA508AccessibilityManager 89 Data = ( 90 ( 91 'Component = pnlBase' 92 'Status = stsDefault') 93 ( 94 'Component = calBeginDate' 95 'Status = stsDefault') 96 ( 97 'Component = calEndDate' 98 'Status = stsDefault') 99 ( 100 'Component = radSort' 101 'Status = stsDefault') 102 ( 103 'Component = cmdOK' 104 'Status = stsDefault') 105 ( 106 'Component = cmdCancel' 107 'Status = stsDefault') 108 ( 109 'Component = frmConsultsByDate' 110 'Status = stsDefault')) 111 end 92 112 end -
cprs/trunk/CPRS-Chart/Consults/fConsultBD.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN, 7 StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults; 7 StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmConsultsByDate = class(T Form)11 TfrmConsultsByDate = class(TfrmBase508Form) 11 12 pnlBase: TORAutoPanel; 12 13 lblBeginDate: TLabel; -
cprs/trunk/CPRS-Chart/Consults/fConsultBS.dfm
r456 r829 1 objectfrmConsultsByService: TfrmConsultsByService1 inherited frmConsultsByService: TfrmConsultsByService 2 2 Left = 339 3 3 Top = 175 4 Width = 3285 Height = 4126 4 BorderIcons = [] 7 5 Caption = 'List Consults by Service' 8 Color = clBtnFace 9 Font.Charset = DEFAULT_CHARSET 10 Font.Color = clWindowText 11 Font.Height = -11 12 Font.Name = 'MS Sans Serif' 13 Font.Style = [] 6 ClientHeight = 385 7 ClientWidth = 320 14 8 OldCreateOrder = True 15 9 Position = poScreenCenter 16 10 PixelsPerInch = 96 17 11 TextHeight = 13 18 object pnlBase: TORAutoPanel 12 object pnlBase: TORAutoPanel [0] 19 13 Left = 0 20 14 Top = 0 … … 90 84 ListItemsOnly = True 91 85 LongList = False 86 LookupPiece = 0 92 87 MaxLength = 0 93 88 Pieces = '2' … … 97 92 OnKeyPause = cboServiceSelect 98 93 OnMouseClick = cboServiceSelect 94 CharsNeedMatch = 1 99 95 end 100 96 end 97 inherited amgrMain: TVA508AccessibilityManager 98 Data = ( 99 ( 100 'Component = pnlBase' 101 'Status = stsDefault') 102 ( 103 'Component = radSort' 104 'Status = stsDefault') 105 ( 106 'Component = cmdOK' 107 'Status = stsDefault') 108 ( 109 'Component = cmdCancel' 110 'Status = stsDefault') 111 ( 112 'Component = treService' 113 'Status = stsDefault') 114 ( 115 'Component = cboService' 116 'Status = stsDefault') 117 ( 118 'Component = frmConsultsByService' 119 'Status = stsDefault')) 120 end 101 121 end -
cprs/trunk/CPRS-Chart/Consults/fConsultBS.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults; 7 ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmConsultsByService = class(T Form)11 TfrmConsultsByService = class(TfrmBase508Form) 11 12 pnlBase: TORAutoPanel; 12 13 lblService: TLabel; … … 71 72 ClientHeight := H; pnlBase.Height := H; 72 73 FChanged := False; 73 // SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP)); {RV}74 SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP)); {RV}74 //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList); {RV} 75 FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList); {RV} 75 76 SortByPiece(TStringList(SvcList), U, 2); {RV} 76 77 for i := 0 to SvcList.Count - 1 do -
cprs/trunk/CPRS-Chart/Consults/fConsultBSt.dfm
r456 r829 1 objectfrmConsultsByStatus: TfrmConsultsByStatus1 inherited frmConsultsByStatus: TfrmConsultsByStatus 2 2 Left = 286 3 3 Top = 202 4 Width = 3165 Height = 2326 4 BorderIcons = [] 7 5 Caption = 'List Consults by Status' 8 Color = clBtnFace 9 Font.Charset = DEFAULT_CHARSET 10 Font.Color = clWindowText 11 Font.Height = -11 12 Font.Name = 'MS Sans Serif' 13 Font.Style = [] 6 ClientHeight = 205 7 ClientWidth = 308 14 8 OldCreateOrder = True 15 9 Position = poScreenCenter 16 10 PixelsPerInch = 96 17 11 TextHeight = 13 18 object pnlBase: TORAutoPanel 12 object pnlBase: TORAutoPanel [0] 19 13 Left = 0 20 14 Top = 0 … … 78 72 end 79 73 end 74 inherited amgrMain: TVA508AccessibilityManager 75 Data = ( 76 ( 77 'Component = pnlBase' 78 'Status = stsDefault') 79 ( 80 'Component = radSort' 81 'Status = stsDefault') 82 ( 83 'Component = lstStatus' 84 'Status = stsDefault') 85 ( 86 'Component = cmdOK' 87 'Status = stsDefault') 88 ( 89 'Component = cmdCancel' 90 'Status = stsDefault') 91 ( 92 'Component = frmConsultsByStatus' 93 'Status = stsDefault')) 94 end 80 95 end -
cprs/trunk/CPRS-Chart/Consults/fConsultBSt.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults; 7 ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmConsultsByStatus = class(T Form)11 TfrmConsultsByStatus = class(TfrmBase508Form) 11 12 pnlBase: TORAutoPanel; 12 13 lblStatus: TLabel; … … 62 63 FChanged := False; 63 64 with radSort do {if SortConsultsAscending then ItemIndex := 0 else} ItemIndex := 1; 64 lstStatus.Items.Assign(SubSetOfStatus);65 FastAssign(SubSetOfStatus, lstStatus.Items); 65 66 CurrentStatus := CurrentContext.Status; 66 67 if CurrentStatus <> '' then with lstStatus do -
cprs/trunk/CPRS-Chart/Consults/fConsults.dfm
r456 r829 1 1 inherited frmConsults: TfrmConsults 2 Left = 247 3 Top = 174 4 Width = 723 5 Height = 467 2 Left = 402 3 Top = 80 6 4 HelpContext = 6000 7 5 Caption = 'Consults Page' 6 ClientHeight = 421 7 ClientWidth = 715 8 8 Menu = mnuConsults 9 9 OnDestroy = FormDestroy 10 10 OnHide = FormHide 11 OnMouseMove = FormMouseMove12 11 OnShow = FormShow 12 ExplicitWidth = 723 13 ExplicitHeight = 467 13 14 PixelsPerInch = 96 14 15 TextHeight = 13 … … 16 17 Top = 416 17 18 Width = 715 19 ExplicitTop = 416 20 ExplicitWidth = 715 18 21 end 19 22 inherited sptHorz: TSplitter … … 22 25 Height = 416 23 26 OnCanResize = sptHorzCanResize 27 ExplicitLeft = 83 28 ExplicitWidth = 2 29 ExplicitHeight = 416 24 30 end 25 31 inherited pnlRight: TPanel [2] … … 27 33 Width = 630 28 34 Height = 416 35 OnExit = pnlRightExit 29 36 OnResize = pnlRightResize 37 ExplicitLeft = 85 38 ExplicitWidth = 630 39 ExplicitHeight = 416 30 40 object sptVert: TSplitter 31 41 Left = 0 … … 44 54 BevelOuter = bvNone 45 55 TabOrder = 0 46 OnExit = pnlResultsExit47 56 object lblTitle: TOROffsetLabel 48 57 Left = 0 … … 91 100 WantReturns = False 92 101 WordWrap = False 93 OnMouseMove = FormMouseMove94 102 end 95 103 end … … 112 120 BevelOuter = bvNone 113 121 TabOrder = 1 114 OnExit = pnlResultsExit115 122 OnResize = pnlResultsResize 116 123 object memResults: TRichEdit … … 132 139 OnChange = memResultChange 133 140 OnKeyDown = memResultsKeyDown 134 OnMouseMove = FormMouseMove135 141 end 136 142 object pnlFields: TPanel … … 240 246 TabOrder = 0 241 247 OnClick = cmdChangeClick 242 OnMouseMove = FormMouseMove243 248 end 244 249 object txtSubject: TCaptionEdit … … 254 259 TabOrder = 1 255 260 Text = 'txtSubject' 256 OnMouseMove = FormMouseMove257 261 Caption = 'Subject' 258 262 end … … 263 267 Width = 83 264 268 Height = 416 269 OnExit = pnlLeftExit 265 270 OnResize = pnlLeftResize 271 ExplicitWidth = 83 272 ExplicitHeight = 416 266 273 object splConsults: TSplitter 267 274 Left = 0 … … 280 287 BevelOuter = bvNone 281 288 TabOrder = 1 282 OnExit = pnlActionExit283 289 object splDrawers: TSplitter 284 290 Left = 0 … … 294 300 Width = 83 295 301 Height = 21 302 Align = alTop 296 303 Caption = 'New Consult' 297 304 Constraints.MinHeight = 21 298 TabOrder = 2 305 Default = True 306 TabOrder = 1 299 307 OnClick = cmdNewConsultClick 300 OnMouseMove = FormMouseMove 301 Align = alTop 308 OnExit = cmdNewConsultExit 302 309 end 303 310 object cmdNewProc: TORAlignButton … … 306 313 Width = 83 307 314 Height = 21 315 Align = alTop 308 316 Caption = 'New Procedure' 309 317 Constraints.MinHeight = 21 310 TabOrder = 3318 TabOrder = 2 311 319 OnClick = cmdNewProcClick 312 OnMouseMove = FormMouseMove313 Align = alTop314 320 end 315 321 object cmdEditResubmit: TORAlignButton … … 318 324 Width = 83 319 325 Height = 21 326 Align = alTop 320 327 Caption = 'Edit/Resubmit' 321 328 Constraints.MinHeight = 21 … … 326 333 Font.Style = [] 327 334 ParentFont = False 328 TabOrder = 1335 TabOrder = 0 329 336 Visible = False 330 337 OnClick = cmdEditResubmitClick 331 OnMouseMove = FormMouseMove 332 Align = alTop 338 OnExit = cmdEditResubmitExit 333 339 end 334 340 object lstNotes: TORListBox … … 345 351 Visible = False 346 352 OnClick = lstNotesClick 347 OnMouseMove = FormMouseMove348 353 ItemTipColor = clWindow 349 354 LongList = False … … 359 364 Constraints.MinWidth = 30 360 365 HideSelection = False 366 Images = dmodShared.imgNotes 361 367 Indent = 19 362 368 PopupMenu = popNoteList 363 369 ReadOnly = True 364 TabOrder = 0 370 StateImages = dmodShared.imgImages 371 TabOrder = 3 365 372 OnChange = tvCsltNotesChange 366 373 OnClick = tvCsltNotesClick … … 369 376 OnDragOver = tvCsltNotesDragOver 370 377 OnExpanded = tvCsltNotesExpanded 371 OnMouseMove = FormMouseMove372 378 OnStartDrag = tvCsltNotesStartDrag 373 379 Caption = 'Consult Notes' … … 380 386 Width = 83 381 387 Height = 21 388 Align = alBottom 382 389 Caption = 'Encounter' 383 390 Enabled = False … … 385 392 Visible = False 386 393 OnClick = cmdPCEClick 387 OnExit = pnlActionExit388 OnMouseMove = FormMouseMove389 Align = alBottom390 394 end 391 395 object pnlConsultList: TPanel … … 436 440 Align = alClient 437 441 HideSelection = False 438 Indent = 15 442 Images = dmodShared.imgConsults 443 Indent = 19 439 444 PopupMenu = popNoteList 440 445 ReadOnly = True 441 446 TabOrder = 0 442 OnAddition = tvConsultsAddition443 447 OnClick = tvConsultsClick 444 448 OnCollapsed = tvConsultsCollapsed 445 OnDeletion = tvConsultsDeletion446 449 OnExit = tvConsultsExit 447 450 OnExpanded = tvConsultsExpanded 448 451 OnKeyUp = tvConsultsKeyUp 449 OnMouseMove = FormMouseMove450 452 Caption = 'Consults' 451 453 NodePiece = 0 … … 453 455 end 454 456 end 457 end 458 inherited amgrMain: TVA508AccessibilityManager 459 Data = ( 460 ( 461 'Component = pnlRead' 462 'Status = stsDefault') 463 ( 464 'Component = memConsult' 465 'Status = stsDefault') 466 ( 467 'Component = memPCEShow' 468 'Status = stsDefault') 469 ( 470 'Component = pnlResults' 471 'Status = stsDefault') 472 ( 473 'Component = memResults' 474 'Status = stsDefault') 475 ( 476 'Component = pnlFields' 477 'Status = stsDefault') 478 ( 479 'Component = lblRefDate' 480 'Status = stsDefault') 481 ( 482 'Component = lblAuthor' 483 'Status = stsDefault') 484 ( 485 'Component = lblVisit' 486 'Status = stsDefault') 487 ( 488 'Component = lblCosigner' 489 'Status = stsDefault') 490 ( 491 'Component = lblSubject' 492 'Status = stsDefault') 493 ( 494 'Component = lblNewTitle' 495 'Status = stsDefault') 496 ( 497 'Component = cmdChange' 498 'Status = stsDefault') 499 ( 500 'Component = txtSubject' 501 'Status = stsDefault') 502 ( 503 'Component = pnlAction' 504 'Status = stsDefault') 505 ( 506 'Component = cmdNewConsult' 507 'Status = stsDefault') 508 ( 509 'Component = cmdNewProc' 510 'Status = stsDefault') 511 ( 512 'Component = cmdEditResubmit' 513 'Status = stsDefault') 514 ( 515 'Component = lstNotes' 516 'Status = stsDefault') 517 ( 518 'Component = tvCsltNotes' 519 'Status = stsDefault') 520 ( 521 'Component = cmdPCE' 522 'Status = stsDefault') 523 ( 524 'Component = pnlConsultList' 525 'Status = stsDefault') 526 ( 527 'Component = lstConsults' 528 'Status = stsDefault') 529 ( 530 'Component = tvConsults' 531 'Status = stsDefault') 532 ( 533 'Component = pnlLeft' 534 'Status = stsDefault') 535 ( 536 'Component = pnlRight' 537 'Status = stsDefault') 538 ( 539 'Component = frmConsults' 540 'Status = stsDefault')) 455 541 end 456 542 object popNoteMemo: TPopupMenu … … 1044 1130 Top = 303 1045 1131 end 1132 object imgLblNotes: TVA508ImageListLabeler 1133 Components = < 1134 item 1135 Component = tvCsltNotes 1136 end> 1137 Labels = <> 1138 RemoteLabeler = dmodShared.imgLblNotes 1139 Left = 16 1140 Top = 48 1141 end 1142 object imgLblImages: TVA508ImageListLabeler 1143 Components = < 1144 item 1145 Component = tvCsltNotes 1146 end> 1147 Labels = <> 1148 RemoteLabeler = dmodShared.imgLblImages 1149 Left = 8 1150 Top = 88 1151 end 1152 object imgLblConsults: TVA508ImageListLabeler 1153 Components = < 1154 item 1155 Component = tvConsults 1156 end> 1157 Labels = <> 1158 RemoteLabeler = dmodShared.imgLblConsults 1159 Left = 56 1160 Top = 96 1161 end 1046 1162 end -
cprs/trunk/CPRS-Chart/Consults/fConsults.pas
r456 r829 1 1 unit fConsults; 2 2 {Notes of Intent: 3 Tab Order: 4 The tab order has been custom coded to place the pnlRight in the Tab order 5 right after the tvConsults. 6 } 3 7 4 8 interface … … 7 11 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORDtTm, 8 12 fHSplit, stdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConsults, rOrders, uPCE, 9 ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList; 13 ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList, 14 VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler; 10 15 11 16 type … … 172 177 mnuViewRemoteData: TMenuItem; 173 178 mnuViewPostings: TMenuItem; 179 imgLblNotes: TVA508ImageListLabeler; 180 imgLblImages: TVA508ImageListLabeler; 181 imgLblConsults: TVA508ImageListLabeler; 174 182 procedure mnuChartTabClick(Sender: TObject); 175 183 procedure lstConsultsClick(Sender: TObject); … … 268 276 procedure popNoteMemoPreviewClick(Sender: TObject); 269 277 procedure popNoteMemoInsTemplateClick(Sender: TObject); 270 procedure tvConsultsAddition(Sender: TObject; Node: TTreeNode);271 procedure tvConsultsDeletion(Sender: TObject; Node: TTreeNode);272 278 procedure tvConsultsExit(Sender: TObject); 273 procedure pnlResultsExit(Sender: TObject);274 procedure pnlActionExit(Sender: TObject);275 279 procedure FormHide(Sender: TObject); 276 280 procedure FormShow(Sender: TObject); 277 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,278 Y: Integer);279 281 procedure ViewInfo(Sender: TObject); 280 282 procedure mnuViewInformationClick(Sender: TObject); 283 procedure pnlLeftExit(Sender: TObject); 284 procedure pnlRightExit(Sender: TObject); 285 procedure cmdEditResubmitExit(Sender: TObject); 286 procedure cmdNewConsultExit(Sender: TObject); 281 287 private 288 FocusToRightPanel : Boolean; 282 289 FEditingIndex: Integer; // TIU index of document being currently edited 283 290 FChanged: Boolean; … … 300 307 FNotifPending: boolean; 301 308 FOldFramePnlPatientExit: TNotifyEvent; 302 FOldDrawerPnlTemplatesButtonExit: TNotifyEvent; 303 FOldDrawerPnlEncounterButtonExit: TNotifyEvent; 304 FOldDrawerEdtSearchExit: TNotifyEvent; 305 FMousing: TDateTime; 309 //FMousing: TDateTime; 310 procedure DoLeftPanelCustomShiftTab; 306 311 procedure frmFramePnlPatientExit(Sender: TObject); 307 procedure frmDrawerPnlTemplatesButtonExit(Sender: TObject);308 procedure frmDrawerPnlEncounterButtonExit(Sender: TObject);309 procedure frmDrawerEdtSearchExit(Sender: TObject);310 312 procedure DoAutoSave(Suppress: integer = 1); 311 313 function GetTitleText(AnIndex: Integer): string; … … 395 397 fReminderDialog, uReminders, fConsMedRslt, fTemplateFieldEditor, 396 398 dShared, rTemplates, fIconLegend, fNoteIDParents, fNoteCPFields, 397 uTemplates, uAccessibleTreeView, uAccessibleTreeNode, fTemplateDialog, DateUtils;399 uTemplates, fTemplateDialog, DateUtils, uVA508CPRSCompatibility, VA508AccessibilityRouter; 398 400 399 401 const … … 906 908 DocInfo := MakeXMLParamTIU(IntToStr(CreatedNote.IEN), FEditNote); 907 909 ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo); 908 memResults.Lines.Assign(TmpBoilerPlate);910 QuickCopyWith508Msg(TmpBoilerPlate, memResults); 909 911 TmpBoilerPlate.Free; 910 912 end; … … 1107 1109 DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote); 1108 1110 ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo); 1109 memResults.Lines.Assign(TmpBoilerPlate);1111 QuickCopyWith508Msg(TmpBoilerPlate, memResults); 1110 1112 TmpBoilerPlate.Free; 1111 1113 end; … … 1221 1223 1222 1224 { Form events -----------------------------------------------------------------} 1225 1226 procedure TfrmConsults.pnlRightExit(Sender: TObject); 1227 begin 1228 inherited; 1229 if TabIsPressed then 1230 FindNextControl(tvConsults, True, True, False).SetFocus 1231 else if ShiftTabIsPressed then 1232 FindNextControl(pnlLeft, True, True, False).SetFocus; 1233 end; 1223 1234 1224 1235 procedure TfrmConsults.pnlRightResize(Sender: TObject); … … 1383 1394 end; 1384 1395 1396 procedure TfrmConsults.cmdNewConsultExit(Sender: TObject); 1397 begin 1398 inherited; 1399 if Not cmdEditResubmit.Visible then 1400 DoLeftPanelCustomShiftTab; 1401 end; 1402 1385 1403 procedure TfrmConsults.cmdNewProcClick(Sender: TObject); 1386 1404 begin … … 2338 2356 mnuActPrintSF513.Enabled := True; 2339 2357 mnuActConsultResults.Enabled := (lstConsults.ItemIEN > 0) and 2340 (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN) ) and2358 (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN) or (UserLevel = UL_UNRESTRICTED)) and 2341 2359 ((status<>ST_DISCONTINUED) and 2342 2360 (status<>ST_CANCELLED))) … … 2365 2383 mnuActComplete.Enabled := mnuActConsultResults.Enabled and 2366 2384 ((MenuAccessRec.UserLevel = UL_UPDATE) or 2367 (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN)) 2385 (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or 2386 (MenuAccessRec.UserLevel = UL_UNRESTRICTED)) 2368 2387 and 2369 2388 ((ConsultRec.ORStatus=ST_PENDING) or … … 2374 2393 mnuActMakeAddendum.Enabled := mnuActConsultResults.Enabled and 2375 2394 ((MenuAccessRec.UserLevel = UL_UPDATE) or 2376 (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN)) 2395 (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or 2396 (MenuAccessRec.UserLevel = UL_UNRESTRICTED)) 2377 2397 and 2378 2398 (ConsultRec.ORStatus=ST_COMPLETE) and … … 2631 2651 if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4)= 'MCAR' then 2632 2652 begin 2633 memConsult.Lines.Assign(GetDetailedMedicineResults(lstNotes.ItemID));2653 QuickCopy(GetDetailedMedicineResults(lstNotes.ItemID), memConsult); 2634 2654 x := Piece(Piece(Piece(lstNotes.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstNotes.ItemID, ';', 1); 2635 NotifyOtherApps(NAE_REPORT, 'MED^' + x); 2655 x := 'MED^' + x; 2656 SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11)); 2657 NotifyOtherApps(NAE_REPORT, x); 2636 2658 end 2637 2659 else … … 2640 2662 mnuActChange.Enabled := False; 2641 2663 mnuActLoadBoiler.Enabled := False; 2642 NotifyOtherApps(NAE_REPORT, 'TIU^' + lstNotes.ItemID); 2664 x := 'TIU^' + lstNotes.ItemID; 2665 SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11)); 2666 NotifyOtherApps(NAE_REPORT, x); 2643 2667 end; 2644 2668 memConsult.SelStart := 0; … … 2814 2838 end; 2815 2839 2840 {for printing multiple notes} 2816 2841 procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList); 2817 2842 var … … 2819 2844 i: integer; 2820 2845 begin 2821 inherited;2822 2846 with AForm.lbIDParents do 2823 begin 2824 for i := 0 to Items.Count - 1 do 2825 begin 2826 if Selected[i] then 2827 begin 2828 NoteIEN := StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0); 2829 if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) else 2830 begin 2831 if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK); 2832 if NoteIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK); 2833 end; 2834 end; {if selected} 2835 end; {for} 2836 end; {with} 2847 for i := 0 to Items.Count - 1 do 2848 if Selected[i] then 2849 begin 2850 NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0); 2851 if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) 2852 else if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK) 2853 else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK); 2854 end; 2837 2855 end; 2838 2856 … … 2852 2870 memConsult.SelStart := 0; 2853 2871 SetResultMenus; 2872 if memConsult.CanFocus then 2873 memConsult.SetFocus; 2854 2874 end; 2855 2875 … … 2883 2903 LimitEditWidth(memResults, MAX_ENTRY_WIDTH - 1); 2884 2904 memResults.Constraints.MinWidth := TextWidthByFont(memResults.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth; 2885 pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width; 2905 //CQ13181 508 Consults--Splitter bar doesn't retain size 2906 //CQ13181 pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width; 2886 2907 end; 2887 2908 2888 2909 procedure TfrmConsults.NotifyOrder(OrderAction: Integer; AnOrder: TOrder); 2910 var 2911 SavedCsltID: string; 2889 2912 begin 2890 2913 if ViewContext = 0 then exit; // form has not yet been displayed, so nothing to update 2891 2914 if EditingIndex <> -1 then exit; // do not rebuild list until after save 2915 with tvConsults do if Selected <> nil then SavedCsltID := lstConsults.ItemID; 2892 2916 case OrderAction of 2893 2917 ORDER_NEW: UpdateList ; 2894 2918 ORDER_SIGN: UpdateList{ sent by fReview, fOrderSign when orders signed, AnOrder=nil} 2895 2919 end; 2920 if SavedCsltID <> '' then with tvConsults do 2921 begin 2922 Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode); 2923 tvConsultsChange(Self, Selected); 2924 end; 2896 2925 end; 2897 2926 … … 2925 2954 begin 2926 2955 inherited; 2956 FocusToRightPanel := False; 2927 2957 PageID := CT_CONSULTS; 2928 memConsult.Color := ReadOnlyColor;2929 memPCEShow.Color := ReadOnlyColor;2930 lblNewTitle.Color := ReadOnlyColor;2931 2958 EditingIndex := -1; 2932 2959 FLastNoteID := ''; … … 2940 2967 frmDrawers.Splitter := splDrawers; 2941 2968 frmDrawers.DefTempPiece := 2; 2942 tvCsltNotes.Images := dmodShared.imgNotes;2943 tvCsltNotes.StateImages := dmodShared.imgImages;2944 tvConsults.Images := dmodShared.imgConsults;2945 2969 FImageFlag := TBitmap.Create; 2946 2970 FDocList := TStringList.Create; … … 2952 2976 end; 2953 2977 FCsltList := TStringList.Create; 2954 TAccessibleTreeView.WrapControl(tvConsults);2955 2978 end; 2956 2979 … … 2968 2991 tvConsultsChange(Self, tvConsults.Selected); 2969 2992 //lstConsultsClick(Self); 2993 if memConsult.CanFocus then 2994 memConsult.SetFocus; 2970 2995 end; 2971 2996 … … 3255 3280 end; 3256 3281 3282 procedure TfrmConsults.cmdEditResubmitExit(Sender: TObject); 3283 begin 3284 inherited; 3285 DoLeftPanelCustomShiftTab; 3286 end; 3287 3257 3288 procedure TfrmConsults.mnuViewSaveAsDefaultClick(Sender: TObject); 3258 3289 begin … … 3291 3322 inherited; 3292 3323 EditTemplates(Self, True); 3324 end; 3325 3326 procedure TfrmConsults.pnlLeftExit(Sender: TObject); 3327 begin 3328 inherited; 3329 if (Not FocusToRightPanel) then 3330 if ShiftTabIsPressed then 3331 frmFrame.tabPage.SetFocus 3332 else if TabIsPressed then 3333 frmFrame.pnlPatient.SetFocus; 3334 3335 if FocusToRightPanel then 3336 FocusToRightPanel := False; 3293 3337 end; 3294 3338 … … 3387 3431 procedure TfrmConsults.FormDestroy(Sender: TObject); 3388 3432 begin 3389 TAccessibleTreeView.UnwrapControl(tvConsults);3390 3433 FDocList.Free; 3391 3434 FCsltList.Free; … … 3578 3621 if (DocType = TYP_ADDENDUM) then 3579 3622 begin 3580 if AskCosignerForDocument(Addend, Author ) and (Cosigner <= 0) then Result := True;3623 if AskCosignerForDocument(Addend, Author, DateTime) and (Cosigner <= 0) then Result := True; 3581 3624 end else 3582 3625 begin … … 3695 3738 ErrMsg: string; 3696 3739 begin 3740 if fFrame.frmFrame.DLLActive = True then Exit; 3697 3741 if (EditingIndex > -1) and FChanged then 3698 3742 begin … … 3711 3755 InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING); 3712 3756 //Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg); 3757 end; 3758 3759 procedure TfrmConsults.DoLeftPanelCustomShiftTab; 3760 begin 3761 if ShiftTabIsPressed then begin 3762 FocusToRightPanel := True; 3763 FindNextControl(frmFrame.pnlPatient, False, True, False).SetFocus; 3764 end; 3713 3765 end; 3714 3766 … … 3828 3880 begin 3829 3881 ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo); 3830 memResults.Lines.Assign(BoilerText);3882 QuickCopyWith508Msg(BoilerText, memResults); 3831 3883 FChanged := False; 3832 3884 end; … … 3849 3901 1: begin 3850 3902 ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo); 3851 memResults.Lines.AddStrings(BoilerText); // append3903 QuickCopyWith508Msg(BoilerText, memResults); // append 3852 3904 end; 3853 3905 2: AssignBoilerText; // replace … … 4283 4335 CreateListItemsforConsultTree(FCsltList, tmpList, ViewContext, GroupBy, Ascending); 4284 4336 UpdateConsultsTreeView(FCsltList, tvConsults); 4285 lstConsults.Items.Assign(tmpList);4337 FastAssign(tmpList, lstConsults.Items); 4286 4338 end; 4287 4339 with tvConsults do … … 4309 4361 uChanging := True; 4310 4362 Items.BeginUpdate; 4311 lstConsults.Items.AddStrings(DocList);4363 FastAddStrings(DocList, lstConsults.Items); 4312 4364 BuildConsultsTree(Tree, DocList, '0', nil, FCurrentContext); 4313 4365 Items.EndUpdate; … … 4539 4591 Signers := TStringList.Create; 4540 4592 try 4541 Signers.Assign(GetCurrentSigners(NoteIEN));4593 FastAssign(GetCurrentSigners(NoteIEN), Signers); 4542 4594 for i := 0 to Signers.Count - 1 do 4543 4595 if Piece(Signers[i], U, 1) = IntToStr(User.DUZ) then … … 4594 4646 end; 4595 4647 4596 procedure TfrmConsults.tvConsultsAddition(Sender: TObject;4597 Node: TTreeNode);4598 begin4599 inherited;4600 TAccessibleTreeNode.WrapControl(Node as TORTreeNode);4601 end;4602 4603 procedure TfrmConsults.tvConsultsDeletion(Sender: TObject;4604 Node: TTreeNode);4605 begin4606 inherited;4607 TAccessibleTreeNode.UnwrapControl(Node as TORTreeNode);4608 end;4609 4610 4648 procedure TfrmConsults.lstConsultsToPrint; 4611 4649 var … … 4630 4668 end; 4631 4669 4632 4633 {Tab Order tricks. Need to change4634 tvConsult4635 4636 tvCsltNotes4637 cmdEditResubmit4638 cmdNewConsult4639 cmdNewProc4640 frmDrawers.pnlTemplateButton4641 frmDrawers.pnlEncounterButton4642 cmdPCE4643 4644 cmdChange4645 txtSubject4646 memResults4647 4648 to4649 tvConsult4650 4651 cmdChange4652 txtSubject4653 memResults4654 4655 tvCsltNotes4656 cmdEditResubmit4657 cmdNewConsult4658 cmdNewProc4659 frmDrawers.pnlTemplateButton4660 frmDrawers.pnlEncounterButton4661 cmdPCE4662 }4663 4664 4670 procedure TfrmConsults.tvConsultsExit(Sender: TObject); 4665 4671 begin 4666 4672 inherited; 4667 if IncSecond(FMousing,1) < Now then 4668 begin 4669 if (Screen.ActiveControl = tvCsltNotes) or 4670 (Screen.ActiveControl = cmdEditResubmit) or 4671 (Screen.ActiveControl = cmdNewConsult) or 4672 (Screen.ActiveControl = cmdNewProc) or 4673 (Screen.ActiveControl = frmDrawers.pnlTemplatesButton) or 4674 (Screen.ActiveControl = frmDrawers.pnlEncounterButton) or 4675 (Screen.ActiveControl = cmdPCE) then 4676 FindNextControl( cmdPCE, True, True, False).SetFocus; 4677 end; 4678 FMousing := 0; 4679 end; 4680 4681 procedure TfrmConsults.pnlResultsExit(Sender: TObject); 4682 begin 4683 inherited; 4684 if IncSecond(FMousing,1) < Now then 4685 begin 4686 if (Screen.ActiveControl = frmFrame.pnlPatient) then 4687 FindNextControl( tvConsults, True, True, False).SetFocus 4688 else 4689 if (Screen.ActiveControl = tvCsltNotes) or 4690 (Screen.ActiveControl = cmdEditResubmit) or 4691 (Screen.ActiveControl = cmdNewConsult) or 4692 (Screen.ActiveControl = cmdNewProc) or 4693 (Screen.ActiveControl = frmDrawers.pnlTemplatesButton) or 4694 (Screen.ActiveControl = frmDrawers.pnlEncounterButton) or 4695 (Screen.ActiveControl = cmdPCE) then 4696 FindNextControl( tvCsltNotes, False, True, False).SetFocus; 4697 end; 4698 FMousing := 0; 4699 end; 4700 4701 procedure TfrmConsults.pnlActionExit(Sender: TObject); 4702 begin 4703 inherited; 4704 if IncSecond(FMousing,1) < Now then 4705 begin 4706 if (Screen.ActiveControl = memConsult) or 4707 (Screen.ActiveControl = cmdChange) or 4708 (Screen.ActiveControl = txtSubject) or 4709 (Screen.ActiveControl = memResults) then 4710 begin 4711 //frmFrame.pnlPatient.SetFocus //COMMENTED OUT FOR CQ6498 4712 if memResults.CanFocus then 4713 memResults.SetFocus //ADDED THIS LINE FOR CQ6498 4714 else 4715 memConsult.SetFocus; 4716 end 4717 else 4718 if (Screen.ActiveControl = tvConsults) then 4719 FindNextControl( frmFrame.pnlPatient, False, True, False).SetFocus; 4720 end; 4721 FMousing := 0; 4673 FocusToRightPanel := True; 4674 if TabIsPressed then 4675 FindNextControl(pnlLeft, False, True, False).SetFocus; 4722 4676 end; 4723 4677 … … 4725 4679 begin 4726 4680 FOldFramePnlPatientExit(Sender); 4727 if IncSecond(FMousing,1) < Now then 4728 begin 4729 if (Screen.ActiveControl = memConsult) or 4730 (Screen.ActiveControl = cmdChange) or 4731 (Screen.ActiveControl = txtSubject) or 4732 (Screen.ActiveControl = memResults) then 4733 FindNextControl( memConsult, False, True, False).SetFocus; 4734 end; 4735 FMousing := 0; 4681 if ShiftTabIsPressed then 4682 FindNextControl( pnlRight, False, True, False).SetFocus; 4736 4683 end; 4737 4684 … … 4740 4687 inherited; 4741 4688 frmFrame.pnlPatient.OnExit := FOldFramePnlPatientExit; 4742 frmDrawers.pnlTemplatesButton.OnExit := FOldDrawerPnlTemplatesButtonExit;4743 frmDrawers.pnlEncounterButton.OnExit := FOldDrawerPnlEncounterButtonExit;4744 frmDrawers.edtSearch.OnExit := FOldDrawerEdtSearchExit;4745 4689 end; 4746 4690 … … 4752 4696 FOldFramePnlPatientExit := frmFrame.pnlPatient.OnExit; 4753 4697 frmFrame.pnlPatient.OnExit := frmFramePnlPatientExit; 4754 FOldDrawerPnlTemplatesButtonExit := frmDrawers.pnlTemplatesButton.OnExit;4755 frmDrawers.pnlTemplatesButton.OnExit := frmDrawerPnlTemplatesButtonExit;4756 FOldDrawerPnlEncounterButtonExit := frmDrawers.pnlEncounterButton.OnExit;4757 frmDrawers.pnlEncounterButton.OnExit := frmDrawerPnlEncounterButtonExit;4758 FOldDrawerEdtSearchExit := frmDrawers.edtSearch.OnExit;4759 frmDrawers.edtSearch.OnExit := frmDrawerEdtSearchExit;4760 4698 {Below is a fix for ClearQuest Defect HDS0000948, Kind of Kloogy I looked 4761 4699 and looked for side effects and a better solution and this was the best!} … … 4773 4711 end 4774 4712 {End of ClearQuest Defect HDS0000948 Fixes} 4775 end;4776 4777 procedure TfrmConsults.frmDrawerEdtSearchExit(Sender: TObject);4778 begin4779 FOldDrawerEdtSearchExit(Sender);4780 pnlActionExit(Sender);4781 end;4782 4783 procedure TfrmConsults.frmDrawerPnlTemplatesButtonExit(Sender: TObject);4784 begin4785 FOldDrawerPnlTemplatesButtonExit(Sender);4786 pnlActionExit(Sender);4787 end;4788 4789 procedure TfrmConsults.frmDrawerPnlEncounterButtonExit(Sender: TObject);4790 begin4791 FOldDrawerPnlEncounterButtonExit(Sender);4792 pnlActionExit(Sender);4793 end;4794 4795 procedure TfrmConsults.FormMouseMove(Sender: TObject; Shift: TShiftState;4796 X, Y: Integer);4797 begin4798 inherited;4799 FMousing := Now;4800 4713 end; 4801 4714 … … 4821 4734 4822 4735 initialization 4736 SpecifyFormIsNotADialog(TfrmConsults); 4823 4737 uPCEEdit := TPCEData.Create; 4824 4738 uPCEShow := TPCEData.Create; -
cprs/trunk/CPRS-Chart/Consults/fConsultsView.dfm
r456 r829 1 objectfrmConsultsView: TfrmConsultsView1 inherited frmConsultsView: TfrmConsultsView 2 2 Left = 320 3 3 Top = 172 4 Width = 4145 Height = 4006 4 BorderIcons = [] 7 5 Caption = 'List Selected Consults' 8 Color = clBtnFace 9 Font.Charset = DEFAULT_CHARSET 10 Font.Color = clWindowText 11 Font.Height = -11 12 Font.Name = 'MS Sans Serif' 13 Font.Style = [] 6 ClientHeight = 373 7 ClientWidth = 406 14 8 OldCreateOrder = True 15 9 Position = poScreenCenter 16 10 PixelsPerInch = 96 17 11 TextHeight = 13 18 object pnlBase: TORAutoPanel 12 object pnlBase: TORAutoPanel [0] 19 13 Left = 0 20 14 Top = 0 … … 154 148 ListItemsOnly = True 155 149 LongList = False 150 LookupPiece = 0 156 151 MaxLength = 0 157 152 Pieces = '2' … … 161 156 OnKeyPause = cboServiceSelect 162 157 OnMouseClick = cboServiceSelect 158 CharsNeedMatch = 1 163 159 end 164 160 object cboGroupBy: TORComboBox … … 182 178 ListItemsOnly = False 183 179 LongList = False 180 LookupPiece = 0 184 181 MaxLength = 0 185 182 Pieces = '2' … … 187 184 SynonymChars = '<>' 188 185 TabOrder = 5 189 end 186 CharsNeedMatch = 1 187 end 188 end 189 inherited amgrMain: TVA508AccessibilityManager 190 Data = ( 191 ( 192 'Component = pnlBase' 193 'Status = stsDefault') 194 ( 195 'Component = calBeginDate' 196 'Status = stsDefault') 197 ( 198 'Component = calEndDate' 199 'Status = stsDefault') 200 ( 201 'Component = lstStatus' 202 'Status = stsDefault') 203 ( 204 'Component = radSort' 205 'Status = stsDefault') 206 ( 207 'Component = cmdOK' 208 'Status = stsDefault') 209 ( 210 'Component = cmdCancel' 211 'Status = stsDefault') 212 ( 213 'Component = treService' 214 'Status = stsDefault') 215 ( 216 'Component = cboService' 217 'Status = stsDefault') 218 ( 219 'Component = cboGroupBy' 220 'Status = stsDefault') 221 ( 222 'Component = frmConsultsView' 223 'Status = stsDefault')) 190 224 end 191 225 object popStatus: TPopupMenu -
cprs/trunk/CPRS-Chart/Consults/fConsultsView.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN, 7 StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus; 7 StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmConsultsView = class(T Form)11 TfrmConsultsView = class(TfrmBase508Form) 11 12 pnlBase: TORAutoPanel; 12 13 lblBeginDate: TLabel; … … 82 83 FChanged := False; 83 84 with radSort do ItemIndex := 1; 84 // SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP)); {RV}85 SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP)); {RV}85 //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList); {RV} 86 FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList); {RV} 86 87 SortByPiece(TStringList(SvcList), U, 2); {RV} 87 88 for i := 0 to SvcList.Count - 1 do … … 103 104 cboServiceSelect(frmConsultsView); 104 105 end; 105 lstStatus.Items.Assign(SubSetOfStatus);106 FastAssign(SubSetOfStatus, lstStatus.Items); 106 107 CurrentStatus := CurrentContext.Status; 107 108 if CurrentStatus <> '' then with lstStatus do -
cprs/trunk/CPRS-Chart/Consults/fCsltNote.dfm
r456 r829 1 objectfrmCsltNote: TfrmCsltNote1 inherited frmCsltNote: TfrmCsltNote 2 2 Left = 147 3 3 Top = 206 … … 6 6 ClientHeight = 189 7 7 ClientWidth = 398 8 Color = clBtnFace9 Font.Charset = DEFAULT_CHARSET10 Font.Color = clWindowText11 Font.Height = -1112 Font.Name = 'MS Sans Serif'13 Font.Style = []14 8 OldCreateOrder = True 15 9 Position = poScreenCenter 16 10 PixelsPerInch = 96 17 11 TextHeight = 13 18 object pnlBase: TORAutoPanel 12 object pnlBase: TORAutoPanel [0] 19 13 Left = 0 20 14 Top = 0 … … 69 63 ListItemsOnly = True 70 64 LongList = False 65 LookupPiece = 0 71 66 MaxLength = 0 72 67 Pieces = '2,3' … … 74 69 SynonymChars = '<>' 75 70 TabOrder = 0 71 CharsNeedMatch = 1 76 72 end 77 73 end 74 inherited amgrMain: TVA508AccessibilityManager 75 Data = ( 76 ( 77 'Component = pnlBase' 78 'Status = stsDefault') 79 ( 80 'Component = cmdOK' 81 'Status = stsDefault') 82 ( 83 'Component = cmdCancel' 84 'Status = stsDefault') 85 ( 86 'Component = cboCsltNote' 87 'Status = stsDefault') 88 ( 89 'Component = frmCsltNote' 90 'Status = stsDefault')) 91 end 78 92 end -
cprs/trunk/CPRS-Chart/Consults/fCsltNote.pas
r456 r829 4 4 5 5 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 6 Buttons, ORCtrls, ORfn, ExtCtrls ;6 Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager; 7 7 8 8 type 9 TfrmCsltNote = class(T Form)9 TfrmCsltNote = class(TfrmBase508Form) 10 10 cmdOK: TButton; 11 11 cmdCancel: TButton; -
cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm
r456 r829 1 objectfrmEditCslt: TfrmEditCslt1 inherited frmEditCslt: TfrmEditCslt 2 2 Tag = 110 3 3 Left = 409 4 4 Top = 225 5 Width = 5 696 Height = 3 675 Width = 599 6 Height = 375 7 7 HorzScrollBar.Range = 561 8 8 VertScrollBar.Range = 340 9 AutoScroll = False10 9 Caption = 'Edit/Resubmit a Cancelled Consult' 11 Color = clBtnFace 12 Font.Charset = DEFAULT_CHARSET 13 Font.Color = clWindowText 14 Font.Height = -11 15 Font.Name = 'MS Sans Serif' 16 Font.Style = [] 10 Constraints.MinHeight = 371 11 Constraints.MinWidth = 573 17 12 OldCreateOrder = True 18 13 Position = poScreenCenter 14 ExplicitLeft = 409 15 ExplicitTop = 225 16 ExplicitWidth = 599 17 ExplicitHeight = 375 19 18 DesignSize = ( 20 5 6121 34 0)19 591 20 341) 22 21 PixelsPerInch = 96 23 22 TextHeight = 13 24 object lblService: TLabel 23 object lblService: TLabel [0] 25 24 Left = 4 26 25 Top = 4 … … 29 28 Caption = 'Consult to Service/Specialty' 30 29 end 31 object lblReason: TLabel 30 object lblReason: TLabel [1] 32 31 Left = 4 33 32 Top = 166 … … 36 35 Caption = 'Reason for Consult' 37 36 end 38 object lblComment: TLabel 37 object lblComment: TLabel [2] 39 38 Left = 4 40 39 Top = 105 … … 43 42 Caption = 'New Comments:' 44 43 end 45 object lblComments: TLabel 44 object lblComments: TLabel [3] 46 45 Left = 4 47 46 Top = 51 … … 50 49 Caption = 'Display Comments:' 51 50 end 52 object lblUrgency: TStaticText 51 object lblUrgency: TStaticText [4] 53 52 Left = 196 54 53 Top = 4 … … 58 57 TabOrder = 16 59 58 end 60 object lblPlace: TStaticText 59 object lblPlace: TStaticText [5] 61 60 Left = 376 62 61 Top = 41 … … 66 65 TabOrder = 17 67 66 end 68 object lblAttn: TStaticText 67 object lblAttn: TStaticText [6] 69 68 Left = 376 70 69 Top = 4 … … 74 73 TabOrder = 18 75 74 end 76 object lblProvDiag: TStaticText 75 object lblProvDiag: TStaticText [7] 77 76 Left = 195 78 77 Top = 82 … … 82 81 TabOrder = 19 83 82 end 84 object lblInpOutp: TStaticText 83 object lblInpOutp: TStaticText [8] 85 84 Left = 197 86 85 Top = 47 … … 90 89 TabOrder = 20 91 90 end 92 object memReason: TRichEdit 91 object memReason: TRichEdit [9] 93 92 Left = 4 94 93 Top = 179 95 Width = 5 5296 Height = 1 2994 Width = 589 95 Height = 137 97 96 Anchors = [akLeft, akTop, akRight, akBottom] 98 97 Font.Charset = DEFAULT_CHARSET … … 111 110 OnKeyPress = memCommentKeyPress 112 111 OnKeyUp = memCommentKeyUp 113 end 114 object pnlMessage: TPanel 115 Left = 21 116 Top = 292 117 Width = 381 112 ExplicitHeight = 136 113 end 114 object pnlMessage: TPanel [10] 115 Left = 16 116 Top = 294 117 Width = 418 118 118 Height = 44 119 119 Anchors = [akLeft, akRight, akBottom] … … 146 146 end 147 147 end 148 object cboService: TORComboBox 148 object cboService: TORComboBox [11] 149 149 Left = 4 150 150 Top = 19 … … 176 176 CharsNeedMatch = 1 177 177 end 178 object cboUrgency: TORComboBox 178 object cboUrgency: TORComboBox [12] 179 179 Left = 196 180 180 Top = 19 … … 200 200 CharsNeedMatch = 1 201 201 end 202 object radInpatient: TRadioButton 202 object radInpatient: TRadioButton [13] 203 203 Left = 197 204 204 Top = 61 … … 209 209 OnClick = radInpatientClick 210 210 end 211 object radOutpatient: TRadioButton 211 object radOutpatient: TRadioButton [14] 212 212 Left = 269 213 213 Top = 61 … … 218 218 OnClick = radOutpatientClick 219 219 end 220 object cboPlace: TORComboBox 220 object cboPlace: TORComboBox [15] 221 221 Left = 376 222 222 Top = 54 223 Width = 179223 Width = 216 224 224 Height = 21 225 225 Anchors = [akLeft, akTop, akRight] … … 243 243 CharsNeedMatch = 1 244 244 end 245 object txtProvDiag: TCaptionEdit 245 object txtProvDiag: TCaptionEdit [16] 246 246 Left = 195 247 247 Top = 95 248 Width = 3 09248 Width = 346 249 249 Height = 21 250 250 Anchors = [akLeft, akTop, akRight] … … 257 257 Caption = 'Provisional Diagnosis' 258 258 end 259 object txtAttn: TORComboBox 259 object txtAttn: TORComboBox [17] 260 260 Left = 376 261 261 Top = 19 262 Width = 181262 Width = 218 263 263 Height = 21 264 264 Anchors = [akLeft, akTop, akRight] … … 283 283 CharsNeedMatch = 1 284 284 end 285 object cboCategory: TORComboBox 285 object cboCategory: TORComboBox [18] 286 286 Left = 561 287 287 Top = 103 … … 305 305 CharsNeedMatch = 1 306 306 end 307 object cmdAccept: TButton 308 Left = 4 07309 Top = 31 3307 object cmdAccept: TButton [19] 308 Left = 437 309 Top = 319 310 310 Width = 72 311 311 Height = 21 … … 315 315 OnClick = cmdAcceptClick 316 316 end 317 object cmdQuit: TButton 318 Left = 484319 Top = 31 3317 object cmdQuit: TButton [20] 318 Left = 514 319 Top = 319 320 320 Width = 72 321 321 Height = 21 … … 326 326 OnClick = cmdQuitClick 327 327 end 328 object memComment: TRichEdit 328 object memComment: TRichEdit [21] 329 329 Left = 4 330 330 Top = 121 331 Width = 5 50331 Width = 587 332 332 Height = 41 333 333 Anchors = [akLeft, akTop, akRight] … … 340 340 OnKeyUp = memCommentKeyUp 341 341 end 342 object btnCmtCancel: TButton 342 object btnCmtCancel: TButton [22] 343 343 Left = 110 344 344 Top = 49 … … 349 349 OnClick = btnCmtCancelClick 350 350 end 351 object btnCmtOther: TButton 351 object btnCmtOther: TButton [23] 352 352 Left = 110 353 353 Top = 75 … … 358 358 OnClick = btnCmtOtherClick 359 359 end 360 object cmdLexSearch: TButton 361 Left = 5 08360 object cmdLexSearch: TButton [24] 361 Left = 545 362 362 Top = 95 363 363 Width = 46 … … 367 367 TabOrder = 9 368 368 OnClick = cmdLexSearchClick 369 end 370 inherited amgrMain: TVA508AccessibilityManager 371 Data = ( 372 ( 373 'Component = lblUrgency' 374 'Status = stsDefault') 375 ( 376 'Component = lblPlace' 377 'Status = stsDefault') 378 ( 379 'Component = lblAttn' 380 'Status = stsDefault') 381 ( 382 'Component = lblProvDiag' 383 'Status = stsDefault') 384 ( 385 'Component = lblInpOutp' 386 'Status = stsDefault') 387 ( 388 'Component = memReason' 389 'Status = stsDefault') 390 ( 391 'Component = pnlMessage' 392 'Status = stsDefault') 393 ( 394 'Component = memMessage' 395 'Status = stsDefault') 396 ( 397 'Component = cboService' 398 'Status = stsDefault') 399 ( 400 'Component = cboUrgency' 401 'Status = stsDefault') 402 ( 403 'Component = radInpatient' 404 'Status = stsDefault') 405 ( 406 'Component = radOutpatient' 407 'Status = stsDefault') 408 ( 409 'Component = cboPlace' 410 'Status = stsDefault') 411 ( 412 'Component = txtProvDiag' 413 'Status = stsDefault') 414 ( 415 'Component = txtAttn' 416 'Status = stsDefault') 417 ( 418 'Component = cboCategory' 419 'Status = stsDefault') 420 ( 421 'Component = cmdAccept' 422 'Status = stsDefault') 423 ( 424 'Component = cmdQuit' 425 'Status = stsDefault') 426 ( 427 'Component = memComment' 428 'Status = stsDefault') 429 ( 430 'Component = btnCmtCancel' 431 'Status = stsDefault') 432 ( 433 'Component = btnCmtOther' 434 'Status = stsDefault') 435 ( 436 'Component = cmdLexSearch' 437 'Status = stsDefault') 438 ( 439 'Component = frmEditCslt' 440 'Status = stsDefault')) 369 441 end 370 442 object mnuPopProvDx: TPopupMenu -
cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons, 8 Menus 8 Menus, fBase508Form, VA508AccessibilityManager; 9 9 10 10 type 11 TfrmEditCslt = class(T Form)11 TfrmEditCslt = class(TfrmBase508Form) 12 12 cboService: TORComboBox; 13 13 cboUrgency: TORComboBox; … … 169 169 begin 170 170 FChanging := True; 171 Defaults.Assign(ODForConsults);171 FastAssign(ODForConsults, Defaults); 172 172 FLastServiceID := ''; 173 173 cboService.Items.Clear; … … 185 185 end; 186 186 StatusText('Initializing Long List'); 187 SvcList.Assign(LoadServiceList(CN_SVC_LIST_ORD)) ;187 FastAssign(LoadServiceList(CN_SVC_LIST_ORD), SvcList) ; 188 188 with cboService do 189 189 begin … … 203 203 ProvDx.CodeInactive := True; 204 204 end; 205 memReason.Lines.Assign(OldRec.RequestReason);205 QuickCopy(OldRec.RequestReason, memReason); 206 206 memComment.Clear ; 207 207 btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0); … … 388 388 RequestReason.Clear 389 389 else 390 RequestReason.Assign(Lines);390 QuickCopy(memReason, RequestReason); 391 391 392 392 with memComment do 393 393 if GetTextLen > 0 then 394 NewComments.Assign(Lines)394 QuickCopy(memComment, NewComments) 395 395 else 396 396 NewComments.Clear; … … 443 443 AStringList := TStringList.Create; 444 444 try 445 AStringList.Assign(memReason.Lines); 445 //QuickCopy(memReason, AStringList); 446 AStringList.Text := memReason.Text; 446 447 LimitStringLength(AStringList, 74); 447 memReason.Lines.Assign(AstringList); 448 //QuickCopy(AstringList, memReason); 449 memReason.Text := AStringList.Text; 448 450 ControlChange(Self); 449 451 finally -
cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm
r456 r829 1 objectfrmEditProc: TfrmEditProc1 inherited frmEditProc: TfrmEditProc 2 2 Tag = 112 3 3 Left = 296 4 4 Top = 245 5 Width = 5 696 Height = 3 355 Width = 571 6 Height = 359 7 7 HorzScrollBar.Range = 561 8 8 VertScrollBar.Range = 308 9 AutoScroll = False10 9 Caption = 'Edit and resubmit a cancelled procedure' 11 Color = clBtnFace 12 Font.Charset = DEFAULT_CHARSET 13 Font.Color = clWindowText 14 Font.Height = -11 15 Font.Name = 'MS Sans Serif' 16 Font.Style = [] 10 Constraints.MinHeight = 359 11 Constraints.MinWidth = 571 17 12 OldCreateOrder = True 18 13 Position = poScreenCenter 14 ExplicitLeft = 296 15 ExplicitTop = 245 16 ExplicitWidth = 571 17 ExplicitHeight = 359 19 18 DesignSize = ( 20 56 121 3 08)19 563 20 325) 22 21 PixelsPerInch = 96 23 22 TextHeight = 13 24 object lblProc: TLabel 23 object lblProc: TLabel [0] 25 24 Left = 3 26 25 Top = 7 … … 29 28 Caption = 'Procedure' 30 29 end 31 object lblReason: TLabel 30 object lblReason: TLabel [1] 32 31 Left = 3 33 32 Top = 167 … … 36 35 Caption = 'Reason for Consult' 37 36 end 38 object lblService: TOROffsetLabel 37 object lblService: TOROffsetLabel [2] 39 38 Left = 3 40 39 Top = 49 … … 47 46 WordWrap = False 48 47 end 49 object lblComment: TLabel 48 object lblComment: TLabel [3] 50 49 Left = 106 51 50 Top = 109 … … 54 53 Caption = 'New Comments' 55 54 end 56 object lblComments: TLabel 55 object lblComments: TLabel [4] 57 56 Left = 3 58 57 Top = 99 … … 61 60 Caption = 'Display Comments:' 62 61 end 63 object lblUrgency: TStaticText 62 object lblUrgency: TStaticText [5] 64 63 Left = 190 65 64 Top = 7 … … 69 68 TabOrder = 18 70 69 end 71 object lblPlace: TStaticText 70 object lblPlace: TStaticText [6] 72 71 Left = 362 73 72 Top = 50 … … 77 76 TabOrder = 19 78 77 end 79 object lblAttn: TStaticText 78 object lblAttn: TStaticText [7] 80 79 Left = 362 81 80 Top = 7 … … 85 84 TabOrder = 20 86 85 end 87 object lblProvDiag: TStaticText 86 object lblProvDiag: TStaticText [8] 88 87 Left = 190 89 88 Top = 81 … … 93 92 TabOrder = 21 94 93 end 95 object lblInpOutp: TStaticText 94 object lblInpOutp: TStaticText [9] 96 95 Left = 192 97 96 Top = 48 … … 101 100 TabOrder = 17 102 101 end 103 object memReason: TRichEdit 102 object memReason: TRichEdit [10] 104 103 Left = 2 105 104 Top = 181 106 Width = 55 5107 Height = 95105 Width = 557 106 Height = 119 108 107 Anchors = [akLeft, akTop, akRight, akBottom] 109 108 Font.Charset = DEFAULT_CHARSET … … 123 122 OnKeyUp = memCommentKeyUp 124 123 end 125 object cmdAccept: TButton 126 Left = 399127 Top = 282124 object cmdAccept: TButton [11] 125 Left = 401 126 Top = 303 128 127 Width = 72 129 128 Height = 21 … … 133 132 OnClick = cmdAcceptClick 134 133 end 135 object cmdQuit: TButton 136 Left = 48 4137 Top = 282134 object cmdQuit: TButton [12] 135 Left = 486 136 Top = 303 138 137 Width = 72 139 138 Height = 21 … … 144 143 OnClick = cmdQuitClick 145 144 end 146 object cboUrgency: TORComboBox 145 object cboUrgency: TORComboBox [13] 147 146 Left = 190 148 147 Top = 22 … … 168 167 CharsNeedMatch = 1 169 168 end 170 object radInpatient: TRadioButton 169 object radInpatient: TRadioButton [14] 171 170 Left = 190 172 171 Top = 61 … … 177 176 OnClick = radInpatientClick 178 177 end 179 object radOutpatient: TRadioButton 178 object radOutpatient: TRadioButton [15] 180 179 Left = 264 181 180 Top = 61 … … 186 185 OnClick = radOutpatientClick 187 186 end 188 object cboPlace: TORComboBox 187 object cboPlace: TORComboBox [16] 189 188 Left = 362 190 189 Top = 63 191 Width = 19 5190 Width = 197 192 191 Height = 21 193 192 Anchors = [akLeft, akTop, akRight] … … 210 209 OnChange = ControlChange 211 210 CharsNeedMatch = 1 212 end 213 object txtProvDiag: TCaptionEdit 211 ExplicitWidth = 195 212 end 213 object txtProvDiag: TCaptionEdit [17] 214 214 Left = 190 215 215 Top = 94 216 Width = 31 3216 Width = 315 217 217 Height = 21 218 218 Anchors = [akLeft, akTop, akRight] … … 225 225 Caption = 'Provisional Diagnosis' 226 226 end 227 object txtAttn: TORComboBox 227 object txtAttn: TORComboBox [18] 228 228 Left = 362 229 229 Top = 22 230 Width = 19 5230 Width = 197 231 231 Height = 21 232 232 Anchors = [akLeft, akTop, akRight] … … 250 250 OnNeedData = txtAttnNeedData 251 251 CharsNeedMatch = 1 252 end 253 object cboProc: TORComboBox 252 ExplicitWidth = 195 253 end 254 object cboProc: TORComboBox [19] 254 255 Left = 3 255 256 Top = 22 … … 283 284 CharsNeedMatch = 1 284 285 end 285 object cboCategory: TORComboBox 286 object cboCategory: TORComboBox [20] 286 287 Left = 505 287 288 Top = -11 … … 306 307 CharsNeedMatch = 1 307 308 end 308 object cboService: TORComboBox 309 object cboService: TORComboBox [21] 309 310 Left = 3 310 311 Top = 65 … … 337 338 CharsNeedMatch = 1 338 339 end 339 object memComment: TRichEdit 340 object memComment: TRichEdit [22] 340 341 Left = 106 341 342 Top = 123 342 Width = 4 49343 Width = 451 343 344 Height = 38 344 345 Anchors = [akLeft, akTop, akRight] … … 349 350 OnKeyUp = memCommentKeyUp 350 351 end 351 object pnlMessage: TPanel 352 Left = 29353 Top = 2 64354 Width = 38 1352 object pnlMessage: TPanel [23] 353 Left = 19 354 Top = 276 355 Width = 383 355 356 Height = 44 356 357 Anchors = [akLeft, akRight, akBottom] … … 383 384 end 384 385 end 385 object btnCmtCancel: TButton 386 object btnCmtCancel: TButton [24] 386 387 Left = 11 387 388 Top = 116 … … 392 393 OnClick = btnCmtCancelClick 393 394 end 394 object btnCmtOther: TButton 395 object btnCmtOther: TButton [25] 395 396 Left = 11 396 397 Top = 139 … … 401 402 OnClick = btnCmtOtherClick 402 403 end 403 object cmdLexSearch: TButton 404 Left = 50 7404 object cmdLexSearch: TButton [26] 405 Left = 509 405 406 Top = 94 406 407 Width = 49 … … 410 411 TabOrder = 8 411 412 OnClick = cmdLexSearchClick 413 end 414 inherited amgrMain: TVA508AccessibilityManager 415 Data = ( 416 ( 417 'Component = lblUrgency' 418 'Status = stsDefault') 419 ( 420 'Component = lblPlace' 421 'Status = stsDefault') 422 ( 423 'Component = lblAttn' 424 'Status = stsDefault') 425 ( 426 'Component = lblProvDiag' 427 'Status = stsDefault') 428 ( 429 'Component = lblInpOutp' 430 'Status = stsDefault') 431 ( 432 'Component = memReason' 433 'Status = stsDefault') 434 ( 435 'Component = cmdAccept' 436 'Status = stsDefault') 437 ( 438 'Component = cmdQuit' 439 'Status = stsDefault') 440 ( 441 'Component = cboUrgency' 442 'Status = stsDefault') 443 ( 444 'Component = radInpatient' 445 'Status = stsDefault') 446 ( 447 'Component = radOutpatient' 448 'Status = stsDefault') 449 ( 450 'Component = cboPlace' 451 'Status = stsDefault') 452 ( 453 'Component = txtProvDiag' 454 'Status = stsDefault') 455 ( 456 'Component = txtAttn' 457 'Status = stsDefault') 458 ( 459 'Component = cboProc' 460 'Status = stsDefault') 461 ( 462 'Component = cboCategory' 463 'Status = stsDefault') 464 ( 465 'Component = cboService' 466 'Status = stsDefault') 467 ( 468 'Component = memComment' 469 'Status = stsDefault') 470 ( 471 'Component = pnlMessage' 472 'Status = stsDefault') 473 ( 474 'Component = memMessage' 475 'Status = stsDefault') 476 ( 477 'Component = btnCmtCancel' 478 'Status = stsDefault') 479 ( 480 'Component = btnCmtOther' 481 'Status = stsDefault') 482 ( 483 'Component = cmdLexSearch' 484 'Status = stsDefault') 485 ( 486 'Component = frmEditProc' 487 'Status = stsDefault')) 412 488 end 413 489 object mnuPopProvDx: TPopupMenu -
cprs/trunk/CPRS-Chart/Consults/fEditProc.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons, 8 Menus ;8 Menus, fBase508Form, VA508AccessibilityManager; 9 9 10 10 type 11 TfrmEditProc = class(T Form)11 TfrmEditProc = class(TfrmBase508Form) 12 12 cmdAccept: TButton; 13 13 cmdQuit: TButton; … … 167 167 FChanging := True; 168 168 Defaults := TStringList.Create; 169 Defaults.Assign(ODForProcedures);169 FastAssign(ODForProcedures, Defaults); 170 170 FLastProcID := ''; 171 171 cboProc.InitLongList(OldRec.ConsultProcName) ; … … 206 206 ProvDx.CodeInactive := True; 207 207 end; 208 memReason.Lines.Assign(OldRec.RequestReason);208 QuickCopy(OldRec.RequestReason, memReason); 209 209 btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0); 210 210 btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0); … … 394 394 RequestReason.Clear 395 395 else 396 RequestReason.Assign(Lines);396 QuickCopy(memReason, RequestReason); 397 397 398 398 with memComment do 399 399 if GetTextLen > 0 then 400 NewComments.Assign(Lines)400 QuickCopy(memComment, NewComments) 401 401 else 402 402 NewComments.Clear; … … 443 443 begin 444 444 Clear; 445 Items.Assign(GetProcedureServices(cboProc.ItemIEN));445 FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items); 446 446 if Items.Count > 0 then 447 447 begin … … 471 471 AStringList := TStringList.Create; 472 472 try 473 AStringList.Assign(memReason.Lines); 473 //QuickCopy(memReason, AStringList); 474 AStringList.Text := memReason.Text; 474 475 LimitStringLength(AStringList, 74); 475 memReason.Lines.Assign(AstringList); 476 //QuickCopy(AstringList, memReason); 477 memReason.Text := AStringList.Text; 476 478 ControlChange(Self); 477 479 finally -
cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm
r456 r829 11 11 Constraints.MinWidth = 606 12 12 Font.Charset = ANSI_CHARSET 13 ExplicitWidth = 606 14 ExplicitHeight = 376 13 15 PixelsPerInch = 96 14 16 TextHeight = 13 … … 20 22 Caption = 'Consult to Service/Specialty' 21 23 end 22 object pnlReason: TPanel [1] 24 object lblProvDiag: TLabel [1] 25 Left = 309 26 Top = 81 27 Width = 100 28 Height = 13 29 Anchors = [akTop, akRight] 30 Caption = 'Provisional Diagnosis' 31 end 32 object lblUrgency: TLabel [2] 33 Left = 309 34 Top = 2 35 Width = 40 36 Height = 13 37 Anchors = [akTop, akRight] 38 Caption = 'Urgency' 39 end 40 object lblPlace: TLabel [3] 41 Left = 454 42 Top = 43 43 Width = 100 44 Height = 13 45 Anchors = [akTop, akRight] 46 Caption = 'Place of Consultation' 47 end 48 object lblAttn: TLabel [4] 49 Left = 454 50 Top = 2 51 Width = 42 52 Height = 13 53 Anchors = [akTop, akRight] 54 Caption = 'Attention' 55 end 56 object pnlReason: TPanel [5] 23 57 Left = 3 24 Top = 1 5458 Top = 128 25 59 Width = 585 26 Height = 1 3560 Height = 161 27 61 Anchors = [akLeft, akTop, akRight] 28 62 BevelOuter = bvNone 29 TabOrder = 1 163 TabOrder = 10 30 64 object lblReason: TLabel 31 65 Left = 0 … … 35 69 Align = alTop 36 70 Caption = 'Reason for Request' 71 ExplicitWidth = 95 37 72 end 38 73 object memReason: TRichEdit … … 40 75 Top = 13 41 76 Width = 585 42 Height = 1 2277 Height = 148 43 78 Align = alClient 44 79 Font.Charset = ANSI_CHARSET … … 60 95 end 61 96 end 62 object lblUrgency: TStaticText [2]63 Left = 30964 Top = 265 Width = 4466 Height = 1767 Anchors = [akTop, akRight]68 Caption = 'Urgency'69 TabOrder = 1770 end71 object lblPlace: TStaticText [3]72 Left = 45473 Top = 4374 Width = 10475 Height = 1776 Anchors = [akTop, akRight]77 Caption = 'Place of Consultation'78 TabOrder = 1879 end80 object lblAttn: TStaticText [4]81 Left = 45482 Top = 283 Width = 4684 Height = 1785 Anchors = [akTop, akRight]86 Caption = 'Attention'87 TabOrder = 1988 end89 object lblProvDiag: TStaticText [5]90 Left = 30991 Top = 8192 Width = 10493 Height = 1794 Anchors = [akTop, akRight]95 Caption = 'Provisional Diagnosis'96 TabOrder = 2097 end98 97 inherited memOrder: TCaptionMemo 99 98 Left = 3 … … 101 100 Width = 417 102 101 Height = 41 102 TabStop = True 103 Anchors = [akLeft, akBottom] 103 104 Lines.Strings = ( 104 105 'The order text...' … … 106 107 '--------------------------------' 107 108 'An order message may be displayed here.') 108 TabOrder = 1 109 end 110 inherited cmdAccept: TButton 111 Left = 427 112 Top = 315 113 TabOrder = 12 114 end 115 inherited cmdQuit: TButton 116 Left = 531 117 Top = 315 118 Width = 61 119 TabOrder = 13 120 end 121 inherited pnlMessage: TPanel 122 Left = 13 123 Top = 295 124 Width = 377 125 Anchors = [akLeft, akRight, akBottom] 126 TabOrder = 14 127 inherited memMessage: TRichEdit 128 Width = 292 129 end 130 end 131 object cboService: TORComboBox 109 TabOrder = 11 110 ExplicitLeft = 3 111 ExplicitTop = 305 112 ExplicitWidth = 417 113 ExplicitHeight = 41 114 end 115 object cboService: TORComboBox [7] 132 116 Left = 0 133 117 Top = 16 … … 151 135 SynonymChars = '<>' 152 136 TabOrder = 0 137 TabStop = True 153 138 OnChange = ControlChange 154 139 OnClick = cboServiceSelect … … 158 143 CharsNeedMatch = 1 159 144 end 160 object cboUrgency: TORComboBox 145 object cboUrgency: TORComboBox [8] 161 146 Left = 309 162 147 Top = 16 … … 166 151 Style = orcsDropDown 167 152 AutoSelect = True 168 Caption = 'Urgency'169 153 Color = clWindow 170 154 DropDownCount = 8 … … 179 163 Sorted = False 180 164 SynonymChars = '<>' 181 TabOrder = 4165 TabOrder = 3 182 166 TabStop = True 183 167 OnChange = ControlChange 184 168 CharsNeedMatch = 1 185 169 end 186 object cboPlace: TORComboBox 170 object cboPlace: TORComboBox [9] 187 171 Left = 454 188 172 Top = 56 … … 192 176 Style = orcsDropDown 193 177 AutoSelect = True 194 Caption = 'Place of Consultation'195 178 Color = clWindow 196 179 DropDownCount = 8 … … 205 188 Sorted = False 206 189 SynonymChars = '<>' 207 TabOrder = 7190 TabOrder = 6 208 191 OnChange = ControlChange 209 192 CharsNeedMatch = 1 210 193 end 211 object txtProvDiag: TCaptionEdit 194 object txtProvDiag: TCaptionEdit [10] 212 195 Left = 309 213 196 Top = 94 … … 219 202 PopupMenu = mnuPopProvDx 220 203 ShowHint = True 221 TabOrder = 9204 TabOrder = 8 222 205 OnChange = txtProvDiagChange 223 Caption = 'Provisional Diagnosis' 224 end 225 object txtAttn: TORComboBox 206 end 207 object txtAttn: TORComboBox [11] 226 208 Left = 454 227 209 Top = 16 … … 231 213 Style = orcsDropDown 232 214 AutoSelect = True 233 Caption = 'Attention'234 215 Color = clWindow 235 216 DropDownCount = 8 … … 244 225 Sorted = False 245 226 SynonymChars = '<>' 246 TabOrder = 5227 TabOrder = 4 247 228 OnChange = ControlChange 248 229 OnNeedData = txtAttnNeedData 249 230 CharsNeedMatch = 1 250 231 end 251 object treService: TORTreeView 232 object treService: TORTreeView [12] 252 233 Left = 0 253 234 Top = 38 … … 264 245 ParentFont = False 265 246 ReadOnly = True 266 TabOrder = 3247 TabOrder = 2 267 248 Visible = False 268 249 OnChange = treServiceChange 269 250 OnCollapsing = treServiceCollapsing 251 OnEnter = treServiceEnter 270 252 OnExit = treServiceExit 271 253 OnKeyDown = treServiceKeyDown 272 254 OnKeyUp = treServiceKeyUp 273 255 OnMouseDown = treServiceMouseDown 274 Caption = 'object lblService: TLabel'275 256 NodePiece = 0 276 257 end 277 object cboCategory: TORComboBox 258 object cboCategory: TORComboBox [13] 278 259 Left = 225 279 260 Top = -5 … … 297 278 CharsNeedMatch = 1 298 279 end 299 object pnlServiceTreeButton: TKeyClickPanel 280 object pnlServiceTreeButton: TKeyClickPanel [14] 300 281 Left = 274 301 282 Top = 14 … … 313 294 Font.Style = [] 314 295 ParentFont = False 315 TabOrder = 2296 TabOrder = 1 316 297 TabStop = True 317 298 OnClick = btnServiceTreeClick … … 323 304 Width = 22 324 305 Height = 22 306 Hint = 'View services/specialties hierarchically' 325 307 Glyph.Data = { 326 308 26050000424D26050000000000003604000028000000100000000F0000000100 … … 367 349 FFFFFFFFFFFFFFFFFFFF} 368 350 Margin = 0 351 ParentShowHint = False 352 ShowHint = True 369 353 OnClick = btnServiceTreeClick 370 354 end 371 355 end 372 object cmdLexSearch: TButton 356 object cmdLexSearch: TButton [15] 373 357 Left = 543 374 358 Top = 94 … … 377 361 Anchors = [akTop, akRight] 378 362 Caption = 'Lexicon' 379 TabOrder = 10363 TabOrder = 9 380 364 OnClick = cmdLexSearchClick 381 365 end 382 object gbInptOpt: TGroupBox 366 object gbInptOpt: TGroupBox [16] 383 367 Left = 309 384 368 Top = 35 … … 387 371 Anchors = [akTop, akRight] 388 372 Caption = 'Patient will be seen as an:' 389 TabOrder = 6373 TabOrder = 5 390 374 object radInpatient: TRadioButton 391 375 Left = 3 … … 407 391 end 408 392 end 409 object btnDiagnosis: TButton 393 object btnDiagnosis: TButton [17] 410 394 Left = 543 411 395 Top = 95 … … 414 398 Anchors = [akTop, akRight] 415 399 Caption = 'Diagnosis' 416 TabOrder = 8400 TabOrder = 7 417 401 OnClick = btnDiagnosisClick 402 end 403 inherited cmdAccept: TButton 404 Left = 439 405 Top = 315 406 Anchors = [akLeft, akBottom] 407 TabOrder = 12 408 ExplicitLeft = 439 409 ExplicitTop = 315 410 end 411 inherited cmdQuit: TButton 412 Left = 531 413 Top = 315 414 Width = 61 415 Anchors = [akLeft, akBottom] 416 TabOrder = 13 417 ExplicitLeft = 531 418 ExplicitTop = 315 419 ExplicitWidth = 61 420 end 421 inherited pnlMessage: TPanel 422 Left = 13 423 Top = 295 424 Width = 377 425 Anchors = [akLeft, akRight, akBottom] 426 TabOrder = 14 427 ExplicitLeft = 13 428 ExplicitTop = 295 429 ExplicitWidth = 377 430 inherited memMessage: TRichEdit 431 Width = 292 432 ExplicitWidth = 292 433 end 434 end 435 inherited amgrMain: TVA508AccessibilityManager 436 Data = ( 437 ( 438 'Component = pnlReason' 439 'Status = stsDefault') 440 ( 441 'Component = memReason' 442 'Label = lblReason' 443 'Status = stsOK') 444 ( 445 'Component = cboService' 446 'Status = stsDefault') 447 ( 448 'Component = cboUrgency' 449 'Label = lblUrgency' 450 'Status = stsOK') 451 ( 452 'Component = cboPlace' 453 'Label = lblPlace' 454 'Status = stsOK') 455 ( 456 'Component = txtProvDiag' 457 'Label = lblProvDiag' 458 'Status = stsOK') 459 ( 460 'Component = txtAttn' 461 'Label = lblAttn' 462 'Status = stsOK') 463 ( 464 'Component = treService' 465 'Status = stsDefault') 466 ( 467 'Component = cboCategory' 468 'Status = stsDefault') 469 ( 470 'Component = pnlServiceTreeButton' 471 'Status = stsDefault') 472 ( 473 'Component = cmdLexSearch' 474 'Status = stsDefault') 475 ( 476 'Component = gbInptOpt' 477 'Status = stsDefault') 478 ( 479 'Component = radInpatient' 480 'Status = stsDefault') 481 ( 482 'Component = radOutpatient' 483 'Status = stsDefault') 484 ( 485 'Component = btnDiagnosis' 486 'Status = stsDefault') 487 ( 488 'Component = memOrder' 489 'Status = stsDefault') 490 ( 491 'Component = cmdAccept' 492 'Status = stsDefault') 493 ( 494 'Component = cmdQuit' 495 'Status = stsDefault') 496 ( 497 'Component = pnlMessage' 498 'Status = stsDefault') 499 ( 500 'Component = memMessage' 501 'Status = stsDefault') 502 ( 503 'Component = frmODCslt' 504 'Status = stsDefault')) 418 505 end 419 506 object mnuPopProvDx: TPopupMenu -
cprs/trunk/CPRS-Chart/Consults/fODConsult.pas
r456 r829 8 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 9 9 fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons, 10 Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet ; 10 Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet, 11 VA508AccessibilityManager ; 11 12 12 13 type … … 18 19 txtAttn: TORComboBox; 19 20 lblService: TLabel; 20 lblUrgency: T StaticText;21 lblPlace: T StaticText;22 lblAttn: T StaticText;23 lblProvDiag: T StaticText;21 lblUrgency: TLabel; 22 lblPlace: TLabel; 23 lblAttn: TLabel; 24 lblProvDiag: TLabel; 24 25 treService: TORTreeView; 25 26 cboCategory: TORComboBox; … … 86 87 procedure cmdQuitClick(Sender: TObject); 87 88 procedure FormClose(Sender: TObject; var Action: TCloseAction); 89 procedure FormResize(Sender: TObject); 90 procedure treServiceEnter(Sender: TObject); 88 91 89 92 private … … 103 106 procedure SaveConsultDxForNurse(pDiagnosis: string); // save the dx entered by nurese if Master BA switch is ON 104 107 procedure SetUpCopyConsultDiagnoses(pOrderID:string); 108 procedure AdjustMemReasonSize; 105 109 protected 106 110 procedure InitDialog; override; … … 125 129 uses 126 130 rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq, 127 ORClasses, clipbrd, uTemplates, fFrame, uODBase ;131 ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility; 128 132 129 133 var … … 153 157 TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.'; 154 158 159 TX_SVC_HRCHY = 'services/specialties hierarchy'; 160 TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically'; 161 TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view'; 162 155 163 procedure TfrmODCslt.FormCreate(Sender: TObject); 156 164 begin … … 180 188 Responses.Dialog := 'GMRCOR CONSULT'; // loads formatting info 181 189 StatusText('Loading Default Values'); 182 Defaults.Assign(ODForConsults); // ODForConsults returns TStrings with defaults190 FastAssign(ODForConsults, Defaults); // ODForConsults returns TStrings with defaults 183 191 CtrlInits.LoadDefaults(Defaults); 184 192 txtAttn.InitLongList('') ; … … 229 237 btnServiceTree.Enabled := True; 230 238 pnlServiceTreeButton.Enabled := True; 231 ActiveControl := cboService;232 239 SetProvDiagPromptingMode; 240 ActiveControl := cboService; // set after call to SetProvDiagPromptingMode 233 241 Changing := False; 234 242 StatusText(''); … … 240 248 'Please contact your Clinical Coordinator/IRM staff to fix this order.'; 241 249 TX_INACTIVE_SVC_CAP = 'Inactive Service'; 250 TX_NO_SVC = 'The order or quick order you have selected does not specify a consult service.' + CRLF + 251 'Please contact your Clinical Coordinator/IRM staff to fix this order.'; 252 TC_NO_SVC = 'No service specified'; 242 253 var 243 254 i:integer; … … 254 265 Changing := True; 255 266 tmpResp := TResponse(FindResponseByName('ORDERABLE',1)); 256 SvcIEN := GetServiceIEN(tmpResp.IValue); 267 if tmpResp <> nil then 268 SvcIEN := GetServiceIEN(tmpResp.IValue) 269 else 270 begin 271 InfoBox(TX_NO_SVC, TC_NO_SVC, MB_ICONERROR or MB_OK); 272 AbortOrder := True; 273 Close; 274 Exit; 275 end; 257 276 if SvcIEN = '-1' then 258 277 begin … … 284 303 SetProvDiagPromptingMode; 285 304 GetProvDxandValidateCode(Responses); 305 SetTemplateDialogCanceled(FALSE); 286 306 SetControl(memReason, 'COMMENT', 1); 307 if WasTemplateDialogCanceled then 308 begin 309 AbortOrder := True; 310 Close; 311 Exit; 312 end; 313 SetTemplateDialogCanceled(FALSE); 287 314 SetupReasonForRequest(OrderAction); 315 if WasTemplateDialogCanceled then 316 begin 317 AbortOrder := True; 318 Close; 319 Exit; 320 end; 288 321 Changing := False; 289 322 ControlChange(Self); … … 292 325 begin 293 326 if QuickList.Count > 0 then BuildQuickTree(QuickList, '0', nil) ; 294 SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD)); {RV}295 AList.Assign(SvcList);327 FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD), SvcList); {RV} 328 FastAssign(SvcList, AList); 296 329 SortByPiece(AList, U, 2); 297 330 BuildServiceTree(treService, SvcList, '0', nil) ; … … 308 341 if QuickList.Count > 0 then with cboService do 309 342 begin 310 Items.Assign(QuickList);343 FastAssign(QuickList, cboService.Items); 311 344 Items.Add(LLS_LINE); 312 345 Items.Add(LLS_SPACE); … … 338 371 Exit; 339 372 end; 340 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));373 QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); 341 374 end; 342 375 PreserveControl(treService); … … 555 588 SetControl(cboPlace, 'PLACE', 1); 556 589 SetControl(txtAttn, 'PROVIDER', 1); 590 SetTemplateDialogCanceled(FALSE); 557 591 SetControl(memReason, 'COMMENT', 1); 592 if WasTemplateDialogCanceled and OrderContainsObjects then 593 begin 594 AbortOrder := TRUE; 595 Close; 596 Exit; 597 end; 558 598 if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then 559 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));599 QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); 560 600 SetupReasonForRequest(ORDER_QUICK); 561 601 GetProvDxandValidateCode(Responses); … … 571 611 Exit; 572 612 end; 573 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));613 QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); 574 614 SetupReasonForRequest(ORDER_NEW); 575 615 end; … … 620 660 end; 621 661 662 procedure TfrmODCslt.treServiceEnter(Sender: TObject); 663 begin 664 inherited; 665 cmdQuit.Cancel := FALSE; 666 end; 667 622 668 procedure TfrmODCslt.treServiceExit(Sender: TObject); 623 669 begin 624 670 inherited; 671 cmdQuit.Cancel := TRUE; 625 672 with cboService do 626 673 begin … … 688 735 AStringList := TStringList.Create; 689 736 try 690 AStringList.Assign(memReason.Lines); 737 //QuickCopy(memReason, AStringList); 738 AStringList.Text := memReason.Text; 691 739 LimitStringLength(AStringList, 74); 692 memReason.Lines.Assign(AstringList); 740 //QuickCopy(AstringList, memReason); 741 memReason.Text := AStringList.Text; 693 742 ControlChange(Self); 694 743 finally … … 762 811 SetControl(cboPlace, 'PLACE', 1); 763 812 SetControl(txtAttn, 'PROVIDER', 1); 813 SetTemplateDialogCanceled(FALSE); 764 814 SetControl(memReason, 'COMMENT', 1); 815 if WasTemplateDialogCanceled and OrderContainsObjects then 816 begin 817 AbortOrder := TRUE; 818 Close; 819 Exit; 820 end; 765 821 // if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then 766 // memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));822 // QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); 767 823 SetupReasonForRequest(ORDER_QUICK); 768 824 GetProvDxandValidateCode(Responses); … … 779 835 Exit; 780 836 end; 781 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));837 QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); 782 838 SetupReasonForRequest(ORDER_NEW); 783 839 Changing := False; … … 824 880 if treService.Visible then 825 881 begin 882 // for some reason screen reader is reading caption when tree view is not visible 883 treService.Caption := TX_SVC_HRCHY; 884 pnlServiceTreeButton.Caption := TX_CLOSE_SVC_HRCHY; 885 btnServiceTree.Hint := TX_CLOSE_SVC_HRCHY; 826 886 treService.SetFocus; 827 887 with treService do for i := 0 to Items.Count-1 do … … 834 894 end; 835 895 end; 896 end 897 else 898 begin 899 treService.Caption := ''; 900 pnlServiceTreeButton.Caption := TX_VIEW_SVC_HRCHY; 901 btnServiceTree.Hint := TX_VIEW_SVC_HRCHY; 902 pnlServiceTreeButton.SetFocus; 836 903 end; 837 904 Changing := False; … … 863 930 txtProvDiag.Enabled := False; 864 931 txtProvDiag.Font.Color := clGrayText; 865 lblProvDiag.Enabled := False;866 932 txtProvDiag.ReadOnly := True; 867 933 txtProvDiag.Color := clBtnFace; … … 940 1006 txtProvDiag.Color := clBtnFace; 941 1007 txtProvDiag.Font.Color := clBtnText; 942 lblProvDiag.Enabled := False;943 1008 txtProvDiag.Hint := ''; 944 1009 if cboService.ItemIEN = 0 then Exit; … … 962 1027 txtProvDiag.Color := clBtnFace; 963 1028 txtProvDiag.Font.Color := clBtnText; 964 lblProvDiag.Enabled := False;965 1029 end 966 1030 else … … 972 1036 txtProvDiag.Color := clWindow; 973 1037 txtProvDiag.Font.Color := clWindowText; 974 lblProvDiag.Enabled := True;975 1038 end; 976 1039 'L': begin … … 989 1052 txtProvDiag.Color := clInfoBk; 990 1053 txtProvDiag.Font.Color := clInfoText; 991 lblProvDiag.Enabled := True;992 1054 end; 993 1055 end; … … 1037 1099 begin 1038 1100 if ((OrderAction = ORDER_QUICK) and (cboService.ItemID <> '') and (Length(memReason.Text) = 0)) then 1039 memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));1101 QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason); 1040 1102 EditReason := GMRCREAF; 1041 1103 if EditReason = '' then EditReason := ReasonForRequestEditable(cboService.ItemID + CSLT_PTR); … … 1065 1127 if ItemIEN > 0 then 1066 1128 begin 1067 Alist.Assign(GetServicePrerequisites(ItemID + CSLT_PTR));1129 FastAssign(GetServicePrerequisites(ItemID + CSLT_PTR), Alist); 1068 1130 if AList.Count > 0 then 1069 1131 begin … … 1154 1216 try 1155 1217 Result := GetDefaultReasonForRequest(Service + CSLT_PTR, Resolve); 1156 TmpSL.Assign(Result);1218 FastAssign(Result, TmpSL); 1157 1219 x := TmpSL.Text; 1158 1220 ExpandOrderObjects(x, HasObjects); … … 1160 1222 Responses.OrderContainsObjects := HasObjects; 1161 1223 ExecuteTemplateOrBoilerPlate(TmpSL, cboService.ItemIEN , ltConsult, nil, 'Reason for Request: ' + cboService.DisplayText[cboService.ItemIndex], DocInfo); 1162 if TmpSL.Text <> x then Responses.OrderContainsObjects := False; 1163 Result.Assign(TmpSL); 1224 AbortOrder := WasTemplateDialogCanceled; 1225 Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects; 1226 if AbortOrder then 1227 begin 1228 Result.Text := ''; 1229 Close; 1230 Exit; 1231 end 1232 else 1233 FastAssignWith508Msg(TmpSL, Result); 1164 1234 finally 1165 1235 TmpSL.Free; … … 1190 1260 treServiceChange(Sender, treService.Selected); 1191 1261 end; 1262 VK_ESCAPE: 1263 begin 1264 key := 0; 1265 btnServiceTreeClick(Self); 1266 end 1192 1267 else 1193 1268 FKeyBoarding := True; … … 1406 1481 end; 1407 1482 1483 procedure TfrmODCslt.FormResize(Sender: TObject); 1484 begin 1485 inherited; 1486 AdjustMemReasonSize(); 1487 end; 1488 1489 procedure TfrmODCslt.AdjustMemReasonSize; 1490 const 1491 PIXEL_SPACE = 3; 1492 begin 1493 pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE; 1494 pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE; 1495 end; 1496 1408 1497 end. 1409 1498 -
cprs/trunk/CPRS-Chart/Consults/fODProc.dfm
r456 r829 10 10 Constraints.MinHeight = 393 11 11 Constraints.MinWidth = 543 12 ExplicitLeft = 208 13 ExplicitTop = 188 14 ExplicitWidth = 543 15 ExplicitHeight = 393 12 16 PixelsPerInch = 96 13 17 TextHeight = 13 … … 119 123 'An order message may be displayed here.') 120 124 TabOrder = 1 125 ExplicitLeft = 0 126 ExplicitTop = 321 127 ExplicitWidth = 380 128 ExplicitHeight = 41 121 129 end 122 130 object cboUrgency: TORComboBox [9] … … 271 279 CharsNeedMatch = 1 272 280 end 273 inherited cmdAccept: TButton 274 Left = 387 275 Top = 339 276 Anchors = [akRight, akBottom] 277 TabOrder = 10 278 end 279 in