- 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 inherited cmdQuit: TButton 280 Left = 469 281 Top = 339 282 Width = 64 283 Anchors = [akRight, akBottom] 284 TabOrder = 11 285 end 286 inherited pnlMessage: TPanel 287 Left = 50 288 Top = 320 289 Width = 316 290 Anchors = [akLeft, akRight, akBottom] 291 TabOrder = 12 292 inherited memMessage: TRichEdit 293 Width = 254 294 end 295 end 296 object cmdLexSearch: TButton 281 object cmdLexSearch: TButton [15] 297 282 Left = 486 298 283 Top = 93 … … 304 289 OnClick = cmdLexSearchClick 305 290 end 306 object gbInptOpt: TGroupBox 291 object gbInptOpt: TGroupBox [16] 307 292 Left = 249 308 293 Top = 36 … … 331 316 end 332 317 end 333 object txtProvDiag: TCaptionEdit 318 object txtProvDiag: TCaptionEdit [17] 334 319 Left = 249 335 320 Top = 93 … … 344 329 OnChange = txtProvDiagChange 345 330 Caption = 'Provisional Diagnosis' 331 end 332 inherited cmdAccept: TButton 333 Left = 387 334 Top = 339 335 Anchors = [akRight, akBottom] 336 TabOrder = 10 337 ExplicitLeft = 387 338 ExplicitTop = 339 339 end 340 inherited cmdQuit: TButton 341 Left = 469 342 Top = 339 343 Width = 64 344 Anchors = [akRight, akBottom] 345 TabOrder = 11 346 ExplicitLeft = 469 347 ExplicitTop = 339 348 ExplicitWidth = 64 349 end 350 inherited pnlMessage: TPanel 351 Left = 50 352 Top = 320 353 Width = 316 354 Anchors = [akLeft, akRight, akBottom] 355 TabOrder = 12 356 ExplicitLeft = 50 357 ExplicitTop = 320 358 ExplicitWidth = 316 359 inherited memMessage: TRichEdit 360 Width = 254 361 ExplicitWidth = 254 362 end 363 end 364 inherited amgrMain: TVA508AccessibilityManager 365 Data = ( 366 ( 367 'Component = lblUrgency' 368 'Status = stsDefault') 369 ( 370 'Component = lblPlace' 371 'Status = stsDefault') 372 ( 373 'Component = lblAttn' 374 'Status = stsDefault') 375 ( 376 'Component = lblProvDiag' 377 'Status = stsDefault') 378 ( 379 'Component = pnlReason' 380 'Status = stsDefault') 381 ( 382 'Component = memReason' 383 'Status = stsDefault') 384 ( 385 'Component = cboUrgency' 386 'Status = stsDefault') 387 ( 388 'Component = cboPlace' 389 'Status = stsDefault') 390 ( 391 'Component = txtAttn' 392 'Status = stsDefault') 393 ( 394 'Component = cboProc' 395 'Status = stsDefault') 396 ( 397 'Component = cboCategory' 398 'Status = stsDefault') 399 ( 400 'Component = cboService' 401 'Status = stsDefault') 402 ( 403 'Component = cmdLexSearch' 404 'Status = stsDefault') 405 ( 406 'Component = gbInptOpt' 407 'Status = stsDefault') 408 ( 409 'Component = radInpatient' 410 'Status = stsDefault') 411 ( 412 'Component = radOutpatient' 413 'Status = stsDefault') 414 ( 415 'Component = txtProvDiag' 416 'Status = stsDefault') 417 ( 418 'Component = memOrder' 419 'Status = stsDefault') 420 ( 421 'Component = cmdAccept' 422 'Status = stsDefault') 423 ( 424 'Component = cmdQuit' 425 'Status = stsDefault') 426 ( 427 'Component = pnlMessage' 428 'Status = stsDefault') 429 ( 430 'Component = memMessage' 431 'Status = stsDefault') 432 ( 433 'Component = frmODProc' 434 'Status = stsDefault')) 346 435 end 347 436 object mnuPopProvDx: TPopupMenu -
cprs/trunk/CPRS-Chart/Consults/fODProc.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons, 8 Menus ;8 Menus, VA508AccessibilityManager; 9 9 10 10 type … … 59 59 procedure memReasonKeyUp(Sender: TObject; var Key: Word; 60 60 Shift: TShiftState); 61 procedure FormDestroy(Sender: TObject);62 61 procedure memReasonKeyDown(Sender: TObject; var Key: Word; 63 62 Shift: TShiftState); … … 90 89 uses 91 90 rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses, 92 clipbrd, fPreReq, uTemplates, uAccessibleRichEdit, fFrame, uODBase; 91 clipbrd, fPreReq, uTemplates, fFrame, uODBase, 92 uVA508CPRSCompatibility; 93 93 94 94 var … … 115 115 inherited; 116 116 DoSetFontSize(MainFontSize); 117 TAccessibleRichEdit.WrapControl(memReason);118 117 AllowQuickOrder := True; 119 118 FillChar(ProvDx, SizeOf(ProvDx), 0); … … 188 187 SetControl(cboProc, 'ORDERABLE', 1); 189 188 if cboProc.ItemIndex < 0 then exit; 190 cboService.Items.Assign(GetProcedureServices(cboProc.ItemIEN));189 FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items); 191 190 Changing := True; 192 191 tmpResp := TResponse(FindResponseByName('CLASS',1)); … … 226 225 SetProvDiagPromptingMode; 227 226 GetProvDxandValidateCode(Responses); 227 SetTemplateDialogCanceled(FALSE); 228 228 SetControl(memReason, 'COMMENT', 1); 229 if WasTemplateDialogCanceled then 230 begin 231 AbortOrder := True; 232 Close; 233 Exit; 234 end; 235 SetTemplateDialogCanceled(FALSE); 229 236 SetupReasonForRequest(OrderAction); 237 if WasTemplateDialogCanceled then 238 begin 239 AbortOrder := True; 240 Close; 241 Exit; 242 end; 230 243 Changing := False; 231 244 OrderMessage(ConsultMessage(cboProc.ItemIEN)); … … 360 373 begin 361 374 Clear; 362 Items.Assign(GetProcedureServices(cboProc.ItemIEN));375 FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items); 363 376 if Items.Count > 1 then 364 377 ItemIndex := -1 … … 385 398 with cboService do 386 399 begin 387 Items.Assign(GetProcedureServices(cboProc.ItemIEN));400 FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items); 388 401 if Items.Count > 1 then 389 402 ItemIndex := -1 … … 402 415 SetControl(cboPlace, 'PLACE', 1); 403 416 SetControl(txtAttn, 'PROVIDER', 1); 417 SetTemplateDialogCanceled(FALSE); 404 418 SetControl(memReason, 'COMMENT', 1); 405 // if ((cboProc.ItemIEN > 0) and (Length(memReason.Text) = 0)) then 406 // memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True)); 419 if WasTemplateDialogCanceled and OrderContainsObjects then 420 begin 421 AbortOrder := TRUE; 422 Close; 423 Exit; 424 end; 407 425 SetupReasonForRequest(ORDER_QUICK); 408 426 GetProvDxandValidateCode(Responses); … … 441 459 Exit; 442 460 end; 443 memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));461 FastAssign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True), memReason.Lines); 444 462 SetupReasonForRequest(ORDER_NEW); 445 463 end; … … 457 475 AStringList := TStringList.Create; 458 476 try 459 AStringList. Assign(memReason.Lines);477 AStringList.Text := memReason.Text; 460 478 LimitStringLength(AStringList, 74); 461 memReason. Lines.Assign(AstringList);479 memReason.Text := AStringList.Text; 462 480 ControlChange(Self); 463 481 finally … … 662 680 begin 663 681 if ((OrderAction = ORDER_QUICK) and (cboProc.ItemID <> '') and (Length(memReason.Text) = 0)) then 664 memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));682 FastAssign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True), memReason.Lines); 665 683 EditReason := GMRCREAF; 666 684 if EditReason = '' then EditReason := ReasonForRequestEditable(Piece(cboProc.Items[cboProc.ItemIndex], U, 4)); … … 690 708 if ItemIEN > 0 then 691 709 begin 692 Alist.Assign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4)));710 FastAssign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4)), Alist); 693 711 if AList.Count > 0 then 694 712 begin … … 708 726 end; 709 727 710 function TfrmODProc.DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings; 728 function TfrmODProc.DefaultReasonForRequest(Service: string; 729 Resolve: Boolean): TStrings; 711 730 var 712 731 TmpSL: TStringList; … … 720 739 try 721 740 Result := GetDefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), Resolve); 722 TmpSL.Assign(Result);741 FastAssign(Result, TmpSL); 723 742 x := TmpSL.Text; 724 743 ExpandOrderObjects(x, HasObjects); 725 744 TmpSL.Text := x; 726 745 Responses.OrderContainsObjects := HasObjects; 727 ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef( piece(piece(cboProc.Items[cboProc.ItemIndex],U,4),';',1),0),746 ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef(Piece(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), ';', 1), 0), 728 747 ltProcedure, nil, 'Reason for Request: ' + cboProc.DisplayText[cboProc.ItemIndex], DocInfo); 729 if TmpSL.Text <> x then Responses.OrderContainsObjects := False; 730 Result.Assign(TmpSL); 748 AbortOrder := WasTemplateDialogCanceled; 749 Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects; 750 if AbortOrder then 751 begin 752 Result.Text := ''; 753 Close; 754 Exit; 755 end 756 else 757 FastAssignWith508Msg(TmpSL, Result); 731 758 finally 732 759 TmpSL.Free; … … 780 807 end; 781 808 782 procedure TfrmODProc.FormDestroy(Sender: TObject);783 begin784 inherited;785 TAccessibleRichEdit.UnwrapControl(memReason);786 end;787 788 809 procedure TfrmODProc.SetFontSize(FontSize: integer); 789 810 begin -
cprs/trunk/CPRS-Chart/Consults/fPreReq.dfm
r456 r829 1 objectfrmPrerequisites: TfrmPrerequisites1 inherited frmPrerequisites: TfrmPrerequisites 2 2 Left = 337 3 3 Top = 219 4 Width = 3775 Height = 3486 4 BorderIcons = [biSystemMenu] 7 5 Caption = 'frmPrerequisites' 8 Color = clBtnFace 6 ClientHeight = 319 7 ClientWidth = 367 9 8 Font.Charset = ANSI_CHARSET 10 Font.Color = clWindowText11 Font.Height = -1112 Font.Name = 'MS Sans Serif'13 Font.Style = []14 9 OldCreateOrder = True 15 10 Position = poScreenCenter 11 OnActivate = OnActivate 16 12 OnClose = FormClose 17 13 OnCreate = FormCreate 18 OnShow = FormShow 14 ExplicitWidth = 375 15 ExplicitHeight = 346 19 16 PixelsPerInch = 96 20 17 TextHeight = 13 21 object lblFontTest: TLabel 18 object lblFontTest: TLabel [0] 22 19 Left = 148 23 20 Top = 208 … … 32 29 ParentFont = False 33 30 end 34 object memReport: TRichEdit 31 object memReport: TRichEdit [1] 35 32 Left = 0 36 33 Top = 33 37 Width = 36 938 Height = 28 834 Width = 367 35 Height = 286 39 36 Align = alClient 40 37 Color = clCream … … 53 50 WordWrap = False 54 51 end 55 object pnlButton: TPanel 52 object pnlButton: TPanel [2] 56 53 Left = 0 57 54 Top = 0 58 Width = 36 955 Width = 367 59 56 Height = 33 60 57 Align = alTop … … 62 59 TabOrder = 2 63 60 DesignSize = ( 64 36 961 367 65 62 33) 66 63 object cmdContinue: TButton 67 Left = 20 964 Left = 207 68 65 Top = 6 69 66 Width = 75 … … 75 72 end 76 73 object cmdCancel: TButton 77 Left = 29 274 Left = 290 78 75 Top = 6 79 76 Width = 75 … … 86 83 end 87 84 end 88 object cmdPrint: TButton 85 object cmdPrint: TButton [3] 89 86 Left = 2 90 87 Top = 6 … … 95 92 OnClick = cmdPrintClick 96 93 end 94 inherited amgrMain: TVA508AccessibilityManager 95 Data = ( 96 ( 97 'Component = memReport' 98 'Status = stsDefault') 99 ( 100 'Component = pnlButton' 101 'Status = stsDefault') 102 ( 103 'Component = cmdContinue' 104 'Status = stsDefault') 105 ( 106 'Component = cmdCancel' 107 'Status = stsDefault') 108 ( 109 'Component = cmdPrint' 110 'Status = stsDefault') 111 ( 112 'Component = frmPrerequisites' 113 'Status = stsDefault')) 114 end 97 115 object dlgPrintReport: TPrintDialog 98 116 Left = 113 -
cprs/trunk/CPRS-Chart/Consults/fPreReq.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORFn, ComCtrls, ExtCtrls; 7 StdCtrls, ORFn, ComCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager, 8 uReports; 8 9 9 10 type 10 TfrmPrerequisites = class(T Form)11 TfrmPrerequisites = class(TfrmBase508Form) 11 12 lblFontTest: TLabel; 12 13 memReport: TRichEdit; … … 20 21 procedure cmdCancelClick(Sender: TObject); 21 22 procedure cmdPrintClick(Sender: TObject); 23 procedure FormClose(Sender: TObject; var Action: TCloseAction); 24 procedure OnActivate(Sender: TObject); 22 25 procedure FormCreate(Sender: TObject); 23 procedure FormClose(Sender: TObject; var Action: TCloseAction);24 procedure FormShow(Sender: TObject);25 26 private 26 27 procedure AlignButtons(); … … 35 36 36 37 uses 37 uCore, rCore, rReports, Printers, rMisc;38 uCore, rCore, rReports, Printers, rMisc; 38 39 39 40 {$R *.DFM} … … 66 67 ForceInsideWorkArea(Rect); 67 68 BoundsRect := Rect; 68 memReport.Lines.Assign(ReportText); 69 ResizeAnchoredFormToFont(result); 69 QuickCopy(ReportText, memReport); 70 70 //Quick fix to work around glich in resize algorithim 71 71 AlignButtons(); … … 127 127 AHeader := TStringList.Create; 128 128 CreatePatientHeader(AHeader, Self.Caption); 129 memPrintReport := TRichEdit.Create(Self);129 memPrintReport := CreateReportTextComponent(Self); 130 130 try 131 131 MaxLines := 60 - AHeader.Count; … … 134 134 with memPrintReport do 135 135 begin 136 Visible := False;137 Parent := Self;138 Font.Name := 'Courier New';139 Font.Size := MainFontSize;140 Width := Printer.Canvas.TextWidth(StringOfChar('-', 74));141 //Width := 600;142 136 repeat 143 137 with Lines do … … 174 168 end; 175 169 176 procedure TfrmPrerequisites.FormCreate(Sender: TObject);177 begin178 memreport.Color := ReadOnlyColor;179 180 end;181 182 170 procedure TfrmPrerequisites.AlignButtons; 183 171 Const 184 172 BtnSpace = 8; 185 173 begin 186 cmdCancel.Left := self.Width - cmdCancel.Width - BtnSpace;174 cmdCancel.Left := self.Width - cmdCancel.Width - (BtnSpace * 3) - 3; 187 175 cmdContinue.Left := cmdCancel.Left - BtnSpace - cmdContinue.Width; 188 176 end; … … 194 182 end; 195 183 196 procedure TfrmPrerequisites.Form Show(Sender: TObject);184 procedure TfrmPrerequisites.FormCreate(Sender: TObject); 197 185 begin 186 inherited; 187 ResizeAnchoredFormToFont(Self); 198 188 SetFormPosition(Self); //Get Saved Position & Size of Form 199 189 end; 200 190 191 procedure TfrmPrerequisites.OnActivate(Sender: TObject); 192 begin 193 if Self.VertScrollBar.IsScrollBarVisible then Self.VertScrollBar.Position := 0; 194 end; 201 195 end. -
cprs/trunk/CPRS-Chart/Consults/rConsults.pas
r456 r829 285 285 Results[i] := x; 286 286 end; 287 Dest.Assign(Results);287 FastAssign(Results, Dest); 288 288 end 289 289 else … … 299 299 begin 300 300 CallV('ORQQCN DETAIL', [IEN]); 301 Dest.Assign(RPCBrokerV.Results);301 FastAssign(RPCBrokerV.Results, Dest); 302 302 end; 303 303 … … 306 306 begin 307 307 CallV('ORQQCN MED RESULTS', [IEN]); 308 Dest.Assign(RPCBrokerV.Results);308 FastAssign(RPCBrokerV.Results, Dest); 309 309 end; 310 310 … … 327 327 alist := TStringList.Create ; 328 328 try 329 alist.Assign(RPCBrokerV.Results);329 FastAssign(RPCBrokerV.Results, aList); 330 330 x := alist[0] ; 331 331 if Piece(x,u,1) <> '-1' then … … 459 459 begin 460 460 CallV('ORQQCN RECEIVE', [IEN, ReceivedBy, RcptDate, Comments]); 461 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}461 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} 462 462 end; 463 463 … … 466 466 begin 467 467 CallV('ORQQCN2 SCHEDULE CONSULT', [IEN, ScheduledBy, SchdDate, Alert, AlertTo, Comments]); 468 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}468 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} 469 469 end; 470 470 … … 473 473 begin 474 474 CallV('ORQQCN DISCONTINUE', [IEN, DeniedBy, DenialDate,'DY',Comments]); 475 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}475 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} 476 476 end; 477 477 … … 480 480 begin 481 481 CallV('ORQQCN DISCONTINUE', [IEN, DiscontinuedBy, DiscontinueDate,'DC',Comments]); 482 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}482 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} 483 483 end; 484 484 … … 486 486 ActionDate: TFMDateTime; Comments: TStrings); 487 487 begin 488 489 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}488 CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]); 489 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} 490 490 end ; 491 491 … … 493 493 AlertTo: string) ; 494 494 begin 495 496 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}495 CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]); 496 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} 497 497 end ; 498 498 … … 500 500 RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ; 501 501 begin 502 503 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}502 CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]); 503 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} 504 504 end ; 505 505 … … 507 507 AlertTo: string) ; 508 508 begin 509 510 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}509 CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]); 510 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'} 511 511 end ; 512 512 … … 831 831 ClinProcDateTime := StrToFMDateTime(Piece(x, U, 4)); 832 832 Title := StrToIntDef(Piece(x, U, 5), 0); 833 DateTime := StrToFloatDef(Piece(x, U, 6), 0); 833 834 end; 834 835 Result := AnEditRec; -
cprs/trunk/CPRS-Chart/Consults/uConsults.pas
r456 r829 38 38 ProvDxCode: string; { 30.1} 39 39 RequestProcessingActivity: TStringList; { 40} 40 //EarliestDate: TFMDateTime; 41 //LatestDate: TFMDateTime; 40 42 end ; 41 43 … … 51 53 Urgency: integer; 52 54 UrgencyName: string; 55 //EarliestDate: TFMDateTime; 56 //LatestDate: TFMDateTime; 53 57 Place: string; 54 58 PlaceName: string; … … 134 138 UL_ADMIN = 3; 135 139 UL_UPDATE_AND_ADMIN = 4; 140 UL_UNRESTRICTED = 5; 136 141 137 142 {Clinical Procedure statuses} … … 297 302 SrcList := TStringList.Create; 298 303 try 299 SrcList.Assign(Source);304 FastAssign(Source, SrcList); 300 305 with SrcList do 301 306 begin -
cprs/trunk/CPRS-Chart/Encounter/fDiagnoses.dfm
r456 r829 5 5 PixelsPerInch = 96 6 6 TextHeight = 13 7 object lblAdd2PL: TLabel [0]8 Left = 5559 Top = 25510 Width = 5311 Height = 2612 Caption = 'Add to Problem list'13 WordWrap = True14 end15 7 inherited lblSection: TLabel 16 8 Width = 89 17 9 Caption = 'Diagnoses Section' 10 ExplicitWidth = 89 18 11 end 19 12 inherited btnOK: TBitBtn … … 26 19 Width = 523 27 20 TabOrder = 1 21 ExplicitWidth = 523 28 22 inherited lbGrid: TORListBox 29 23 Tag = 20 30 24 Width = 523 31 25 Pieces = '1,2,3' 26 ExplicitWidth = 523 32 27 end 33 28 inherited hcGrid: THeaderControl … … 52 47 Width = 110 53 48 end> 49 ExplicitWidth = 523 54 50 end 55 51 end 56 52 inherited edtComment: TCaptionEdit 57 53 TabOrder = 3 54 end 55 object cmdDiagPrimary: TButton [8] 56 Left = 536 57 Top = 306 58 Width = 75 59 Height = 21 60 Caption = 'Primary' 61 Enabled = False 62 TabOrder = 5 63 OnClick = cmdDiagPrimaryClick 64 end 65 object ckbDiagProb: TCheckBox [9] 66 Left = 535 67 Top = 258 68 Width = 76 69 Height = 38 70 Caption = 'Add to Problem list' 71 TabOrder = 4 72 WordWrap = True 73 OnClick = ckbDiagProbClicked 58 74 end 59 75 inherited btnRemove: TButton … … 64 80 TabOrder = 2 65 81 TabStop = True 82 ExplicitLeft = 454 66 83 end 67 84 inherited pnlMain: TPanel … … 72 89 IntegralHeight = True 73 90 Pieces = '2,3,4,5' 91 ExplicitHeight = 196 74 92 end 75 93 inherited pnlLeft: TPanel … … 85 103 end 86 104 end 87 object cmdDiagPrimary: TButton 88 Left = 536 89 Top = 306 90 Width = 75 91 Height = 21 92 Caption = 'Primary' 93 Enabled = False 94 TabOrder = 5 95 OnClick = cmdDiagPrimaryClick 96 end 97 object ckbDiagProb: TCheckBox 98 Left = 536 99 Top = 262 100 Width = 13 101 Height = 13 102 Caption = 'Add to Problem list' 103 TabOrder = 4 104 OnClick = ckbDiagProbClicked 105 inherited amgrMain: TVA508AccessibilityManager 106 Data = ( 107 ( 108 'Component = cmdDiagPrimary' 109 'Status = stsDefault') 110 ( 111 'Component = ckbDiagProb' 112 'Status = stsDefault') 113 ( 114 'Component = edtComment' 115 'Label = lblComment' 116 'Status = stsOK') 117 ( 118 'Component = btnRemove' 119 'Status = stsDefault') 120 ( 121 'Component = btnSelectAll' 122 'Status = stsDefault') 123 ( 124 'Component = pnlMain' 125 'Status = stsDefault') 126 ( 127 'Component = lbxSection' 128 'Label = lblList' 129 'Status = stsOK') 130 ( 131 'Component = pnlLeft' 132 'Status = stsDefault') 133 ( 134 'Component = lbSection' 135 'Label = lblSection' 136 'Status = stsOK') 137 ( 138 'Component = btnOther' 139 'Status = stsDefault') 140 ( 141 'Component = pnlGrid' 142 'Status = stsDefault') 143 ( 144 'Component = lbGrid' 145 'Status = stsDefault') 146 ( 147 'Component = hcGrid' 148 'Status = stsDefault') 149 ( 150 'Component = btnOK' 151 'Status = stsDefault') 152 ( 153 'Component = btnCancel' 154 'Status = stsDefault') 155 ( 156 'Component = frmDiagnoses' 157 'Status = stsDefault')) 105 158 end 106 159 end -
cprs/trunk/CPRS-Chart/Encounter/fDiagnoses.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, StdCtrls, CheckLst, ORCtrls, ORNet, ExtCtrls, Buttons, uPCE, rPCE, ORFn, 8 ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore ;8 ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore, VA508AccessibilityManager; 9 9 10 10 type … … 12 12 cmdDiagPrimary: TButton; 13 13 ckbDiagProb: TCheckBox; 14 lblAdd2PL: TLabel;15 14 procedure cmdDiagPrimaryClick(Sender: TObject); 16 15 procedure ckbDiagProbClicked(Sender: TObject); … … 49 48 50 49 uses 51 fEncounterFrame, uConst, UBACore ;50 fEncounterFrame, uConst, UBACore, VA508AccessibilityRouter; 52 51 53 52 procedure TfrmDiagnoses.EnsurePrimaryDiag; … … 153 152 PLItemCount := PLItemCount + 1; 154 153 OK := OK and (PLItemCount < lbGrid.SelCount); 155 lblAdd2PL.Enabled := OK;156 154 ckbDiagProb.Enabled := OK; 157 155 if(OK) then … … 182 180 begin 183 181 inherited; 182 if lbxSection.width = 0 then Exit; 184 183 FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth); 185 184 FSectionTabs[1] := -FSectionTabs[0]+2; … … 257 256 end; 258 257 258 initialization 259 SpecifyFormIsNotADialog(TfrmDiagnoses); 260 259 261 end. -
cprs/trunk/CPRS-Chart/Encounter/fEncVitals.dfm
r456 r829 3 3 Top = 210 4 4 Caption = 'Vitals' 5 KeyPreview = True6 5 OnActivate = FormActivate 7 On Destroy = FormDestroy8 OnKeyDown = FormKeyDown9 OnResize = FormResize6 OnShow = FormShow 7 ExplicitWidth = 632 8 ExplicitHeight = 427 10 9 PixelsPerInch = 96 11 10 TextHeight = 13 … … 15 14 Width = 624 16 15 Height = 368 17 Hint = 'To sort, click on column headers|'18 16 Align = alClient 19 17 Columns = <> … … 35 33 Align = alBottom 36 34 BevelOuter = bvNone 37 TabOrder = 5 35 TabOrder = 4 36 object btnEnterVitals: TButton 37 Left = 8 38 Top = 6 39 Width = 75 40 Height = 21 41 Caption = 'Enter Vitals' 42 TabOrder = 0 43 OnClick = btnEnterVitalsClick 44 end 45 object btnOKkludge: TButton 46 Left = 434 47 Top = 6 48 Width = 75 49 Height = 21 50 Caption = 'OK' 51 TabOrder = 1 52 OnClick = btnOKClick 53 end 54 object btnCancelkludge: TButton 55 Left = 522 56 Top = 6 57 Width = 75 58 Height = 21 59 Caption = 'Cancel' 60 TabOrder = 2 61 OnClick = btnCancelClick 62 end 38 63 end 39 64 inherited btnOK: TBitBtn 40 Left = 444 41 Top = 377 42 TabOrder = 3 65 Left = 208 66 Top = 374 67 Caption = 'OK No Show' 68 TabOrder = 2 69 Visible = False 70 ExplicitLeft = 208 71 ExplicitTop = 374 43 72 end 44 73 inherited btnCancel: TBitBtn 45 Left = 524 46 Top = 377 47 TabOrder = 4 74 Left = 289 75 Top = 374 76 Caption = 'Cancel No Show' 77 TabOrder = 3 78 Visible = False 79 ExplicitLeft = 289 80 ExplicitTop = 374 48 81 end 49 object pnlmain: TPanel 82 object pnlmain: TPanel [4] 50 83 Left = 28 51 84 Top = 24 … … 443 476 end 444 477 end 445 object btnEnterVitals: TButton 446 Left = 8 447 Top = 377 448 Width = 75 449 Height = 21 450 Caption = 'Enter Vitals' 451 TabOrder = 2 452 OnClick = btnEnterVitalsClick 478 inherited amgrMain: TVA508AccessibilityManager 479 Data = ( 480 ( 481 'Component = lvVitals' 482 'Status = stsDefault') 483 ( 484 'Component = pnlBottom' 485 'Status = stsDefault') 486 ( 487 'Component = btnEnterVitals' 488 'Status = stsDefault') 489 ( 490 'Component = btnOKkludge' 491 'Status = stsDefault') 492 ( 493 'Component = btnCancelkludge' 494 'Status = stsDefault') 495 ( 496 'Component = pnlmain' 497 'Status = stsDefault') 498 ( 499 'Component = lblDate' 500 'Status = stsDefault') 501 ( 502 'Component = lblDateBP' 503 'Status = stsDefault') 504 ( 505 'Component = lblDateTemp' 506 'Status = stsDefault') 507 ( 508 'Component = lblDateResp' 509 'Status = stsDefault') 510 ( 511 'Component = lblDatePulse' 512 'Status = stsDefault') 513 ( 514 'Component = lblDateHeight' 515 'Status = stsDefault') 516 ( 517 'Component = lblDateWeight' 518 'Status = stsDefault') 519 ( 520 'Component = lblLstMeas' 521 'Status = stsDefault') 522 ( 523 'Component = lbllastBP' 524 'Status = stsDefault') 525 ( 526 'Component = lblLastTemp' 527 'Status = stsDefault') 528 ( 529 'Component = lblLastResp' 530 'Status = stsDefault') 531 ( 532 'Component = lblLastPulse' 533 'Status = stsDefault') 534 ( 535 'Component = lblLastHeight' 536 'Status = stsDefault') 537 ( 538 'Component = lblLastWeight' 539 'Status = stsDefault') 540 ( 541 'Component = lblVital' 542 'Status = stsDefault') 543 ( 544 'Component = lblVitBP' 545 'Status = stsDefault') 546 ( 547 'Component = lnlVitTemp' 548 'Status = stsDefault') 549 ( 550 'Component = lblVitResp' 551 'Status = stsDefault') 552 ( 553 'Component = lblVitPulse' 554 'Status = stsDefault') 555 ( 556 'Component = lblVitHeight' 557 'Status = stsDefault') 558 ( 559 'Component = lblVitWeight' 560 'Status = stsDefault') 561 ( 562 'Component = lblVitPain' 563 'Status = stsDefault') 564 ( 565 'Component = lblLastPain' 566 'Status = stsDefault') 567 ( 568 'Component = lblDatePain' 569 'Status = stsDefault') 570 ( 571 'Component = txtMeasBP' 572 'Status = stsDefault') 573 ( 574 'Component = cboTemp' 575 'Status = stsDefault') 576 ( 577 'Component = txtMeasTemp' 578 'Status = stsDefault') 579 ( 580 'Component = txtMeasResp' 581 'Status = stsDefault') 582 ( 583 'Component = cboHeight' 584 'Status = stsDefault') 585 ( 586 'Component = txtMeasWt' 587 'Status = stsDefault') 588 ( 589 'Component = cboWeight' 590 'Status = stsDefault') 591 ( 592 'Component = txtMeasDate' 593 'Status = stsDefault') 594 ( 595 'Component = cboPain' 596 'Status = stsDefault') 597 ( 598 'Component = txtMeasPulse' 599 'Status = stsDefault') 600 ( 601 'Component = txtMeasHt' 602 'Status = stsDefault') 603 ( 604 'Component = btnOK' 605 'Status = stsDefault') 606 ( 607 'Component = btnCancel' 608 'Status = stsDefault') 609 ( 610 'Component = frmEncVitals' 611 'Status = stsDefault')) 453 612 end 454 613 end -
cprs/trunk/CPRS-Chart/Encounter/fEncVitals.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, ORDtTm, StdCtrls, ORCtrls, ExtCtrls, Buttons, fAutoSz, ORFn, 8 rvitals, ComCtrls, ORNet, uVitals 9 , TRPCB // Vitals Lite 2004-05-21 =========================================== 10 ; 11 {== Vitals Lite 2004-05-21 ===================================================} 12 type 13 TGMV_GetInputPanel = function( 14 var anApp: TApplication; 15 aB: TRPCBroker; 16 aP, // Patient DFN 17 aL, // Hospitals IEN 18 aSig, // Application signature 19 aTemplate // Vitals Input template 20 : String; 21 aNow // Input Date/Time 22 :TDateTime):TCustomForm; 23 {== Vitals Lite 2004-05-21 ===================================================} 8 rvitals, ComCtrls, ORNet, uVitals, VAUtils, TRPCB, VA508AccessibilityManager; 24 9 25 10 type … … 63 48 txtMeasHt: TCaptionEdit; 64 49 pnlBottom: TPanel; 50 lvVitals: TCaptionListView; 65 51 btnEnterVitals: TButton; 66 lvVitals: TCaptionListView; 52 btnOKkludge: TButton; 53 btnCancelkludge: TButton; 67 54 procedure SetVitPointer(Sender: TObject); 68 55 procedure txtMeasBPExit(Sender: TObject); … … 87 74 procedure txtMeasHtExit(Sender: TObject); 88 75 procedure txtMeasWtExit(Sender: TObject); 89 procedure FormKeyDown(Sender: TObject; var Key: Word;90 Shift: TShiftState);91 76 procedure btnEnterVitalsClick(Sender: TObject); //vitals lite 92 77 private … … 120 105 fEncounterFrame, uInit 121 106 // , fGMV_InputTemp // Vitals Lite 2004-05-21 122 ;107 , VA508AccessibilityRouter; 123 108 124 109 const … … 418 403 419 404 {== Vitals Lite 2004-05-21 ===================================================} 420 FreeLibrary(VitalsDLLHandle); 405 if VitalsDLLHandle <> 0 then 406 begin 407 FreeLibrary(VitalsDLLHandle); 408 VitalsDLLHandle := 0; 409 end; 421 410 {== Vitals Lite 2004-05-21 ===================================================} 422 411 inherited; … … 448 437 GMV_LibName :='GMV_VitalsViewEnter.dll'; 449 438 GMV_LibName := GetProgramFilesPath + SHARE_DIR + GMV_LibName; 450 VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName)); 439 if VitalsDLLHandle = 0 then 440 VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName)); 451 441 if VitalsDLLHandle = 0 then // No Handle found 452 442 MessageDLG('Can''t find library "'+GMV_LibName+'".',mtError,[mbok],0) … … 555 545 txtMeasWt.text := ''; 556 546 cboPain.text := ''; 557 end;558 559 procedure TfrmEncVitals.FormKeyDown(Sender: TObject; var Key: Word;560 Shift: TShiftState);561 begin562 {capture return key press if on the vital screen}563 begin564 inherited;565 if (ActiveCtrl.tag in VitalDateTagSet)then566 begin567 if Key = VK_RETURN then568 begin569 Key := 0;570 if (ActiveCtrl.Tag = TAG_VITPAIN) then571 ChangeFocus(btnOK)572 else573 begin574 GetParentForm(Self).Perform(WM_NEXTDLGCTL,0,0);575 SetVitPointer(Sender);576 end;577 end;578 end;579 end;580 547 end; 581 548 … … 636 603 end 637 604 else 638 MessageDLG(' Can notfind function "'+GMV_FName+'".',mtError,[mbok],0);605 MessageDLG('Unable to find function "'+GMV_FName+'".',mtError,[mbok],0); 639 606 @VLPtVitals := nil; 640 607 LoadVitalsList; … … 652 619 if assigned(VLPtVitals) then 653 620 begin 654 frmFrame.VitalsDLLActive := True; // need this flag for CCOW (RV)621 // frmFrame.DLLActive := True; // need this flag for CCOW (RV) 655 622 VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false); 656 623 if assigned(VitalsList) then … … 660 627 MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0); 661 628 @VLPtVitals := nil; 662 frmFrame.VitalsDLLActive := False; // need this flag for CCOW (RV)629 // frmFrame.DLLActive := False; // need this flag for CCOW (RV) 663 630 end; 664 631 //End Vitals Lite 665 632 633 initialization 634 SpecifyFormIsNotADialog(TfrmEncVitals); 635 666 636 end. -
cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.dfm
r456 r829 1 objectfrmEncounterFrame: TfrmEncounterFrame1 inherited frmEncounterFrame: TfrmEncounterFrame 2 2 Left = 290 3 3 Top = 108 4 Width = 6405 Height = 4516 4 Caption = 'Encounter Frame' 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 = [] 5 ClientHeight = 424 6 ClientWidth = 632 13 7 FormStyle = fsMDIForm 14 KeyPreview = True15 8 OldCreateOrder = True 16 9 Position = poScreenCenter … … 20 13 OnCreate = FormCreate 21 14 OnDestroy = FormDestroy 22 OnKeyDown = FormKeyDown23 15 OnResize = FormResize 16 OnShow = FormShow 17 ExplicitLeft = 290 18 ExplicitTop = 108 19 ExplicitWidth = 640 20 ExplicitHeight = 458 24 21 PixelsPerInch = 96 25 22 TextHeight = 13 26 object Bevel1: TBevel 23 object Bevel1: TBevel [0] 27 24 Left = 0 28 25 Top = 0 … … 31 28 Align = alTop 32 29 end 33 object StatusBar1: TStatusBar 30 object StatusBar1: TStatusBar [1] 34 31 Left = 0 35 Top = 4 1732 Top = 424 36 33 Width = 632 37 34 Height = 0 38 35 Panels = <> 39 SimplePanel = False40 36 end 41 object pnlPage: TPanel 37 object pnlPage: TPanel [2] 42 38 Left = 0 43 39 Top = 24 44 40 Width = 632 45 Height = 39341 Height = 400 46 42 Align = alClient 47 43 BevelOuter = bvNone … … 54 50 TabOrder = 1 55 51 end 56 object TabControl: TTabControl 52 object TabControl: TTabControl [3] 57 53 Left = 0 58 54 Top = 2 … … 63 59 OnChange = TabControlChange 64 60 OnChanging = TabControlChanging 65 OnExit = TabControlExit 61 OnEnter = TabControlEnter 62 end 63 inherited amgrMain: TVA508AccessibilityManager 64 Data = ( 65 ( 66 'Component = StatusBar1' 67 'Status = stsDefault') 68 ( 69 'Component = pnlPage' 70 'Status = stsDefault') 71 ( 72 'Component = TabControl' 73 'Status = stsDefault') 74 ( 75 'Component = frmEncounterFrame' 76 'Status = stsDefault')) 66 77 end 67 78 end -
cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.pas
r456 r829 7 7 Tabs, ComCtrls, ExtCtrls, Menus, StdCtrls, Buttons, fPCEBase, 8 8 fVisitType, fDiagnoses, fProcedure, fImmunization, fSkinTest, fPatientEd, 9 fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals,rvitals; 9 fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals, rvitals, fBase508Form, 10 VA508AccessibilityManager; 10 11 11 12 const … … 56 57 57 58 type 58 TfrmEncounterFrame = class(T Form)59 TfrmEncounterFrame = class(TfrmBase508Form) 59 60 StatusBar1: TStatusBar; 60 61 pnlPage: TPanel; … … 72 73 procedure TabControlChanging(Sender: TObject; 73 74 var AllowChange: Boolean); 74 procedure TabControlExit(Sender: TObject);75 75 procedure FormKeyDown(Sender: TObject; var Key: Word; 76 76 Shift: TShiftState); … … 78 78 procedure FormCanResize(Sender: TObject; var NewWidth, 79 79 NewHeight: Integer; var Resize: Boolean); 80 procedure FormShow(Sender: TObject); 81 procedure TabControlEnter(Sender: TObject); 80 82 81 83 private … … 88 90 //in the frame. They must be available at compile time 89 91 FLastPage: TfrmPCEBase; 92 FGiveMultiTabMessage: boolean; 90 93 procedure CreateChildForms(Sender: TObject; Location: integer); 91 94 procedure SynchPCEData; … … 124 127 uCore, 125 128 fGAF, uConst, 126 rCore, fPCEProvider, rMisc ;129 rCore, fPCEProvider, rMisc, VA508AccessibilityRouter, VAUtils; 127 130 128 131 {$R *.DFM} … … 549 552 FAbort := TRUE; 550 553 SetFormFonts; 554 FGiveMultiTabMessage := ScreenReaderSystemActive; 551 555 end; 552 556 … … 582 586 if (Storemessage <> 'True') then 583 587 begin 584 showmessage(storemessage);588 ShowMsg(storemessage); 585 589 // exit; 586 590 end; … … 680 684 if (sender as tTabControl).tabindex = -1 then exit; 681 685 686 if TabControl.CanFocus and Assigned(FLastPage) and not TabControl.Focused then 687 TabControl.SetFocus; //CQ: 14845 688 682 689 for i := CT_FIRST to CT_LAST do 683 690 begin … … 688 695 PageIDToForm(i).show; 689 696 SwitchToPage(PageIDToForm(i)); 697 Exit; 690 698 end; 691 699 end; … … 736 744 end; 737 745 738 procedure TfrmEncounterFrame.TabControlExit(Sender: TObject); 739 var 740 i: integer; 741 begin 742 //Keep the focus on the active page 743 if (sender as tTabControl).tabindex = -1 then exit; 744 745 for i := CT_FIRST to CT_LAST do 746 begin 747 with Formlist do 748 with sender as tTabControl do 749 if Tabindex = IndexOf(PageIdToTab(i)) then 750 begin 751 PageIDToForm(i).FocusFirstControl; 752 end; 746 procedure TfrmEncounterFrame.TabControlEnter(Sender: TObject); 747 begin 748 if FGiveMultiTabMessage then // CQ#15483 749 begin 750 FGiveMultiTabMessage := FALSE; 751 GetScreenReader.Speak('Multi tab form'); 753 752 end; 754 753 end; … … 759 758 CanChange: boolean; 760 759 begin 760 inherited; 761 761 if (Key = VK_ESCAPE) then 762 762 begin … … 788 788 end; 789 789 end; 790 if FLastPage = frmEncVitals then791 frmEncVitals.FormKeyDown(Sender, Key, Shift);792 790 end; 793 791 … … 836 834 end; 837 835 836 procedure TfrmEncounterFrame.FormShow(Sender: TObject); 837 begin 838 inherited; 839 if TabControl.CanFocus then 840 TabControl.SetFocus; 841 end; 842 838 843 end. -
cprs/trunk/CPRS-Chart/Encounter/fExam.dfm
r456 r829 3 3 Top = 223 4 4 Caption = 'Encounter Examinations' 5 ExplicitLeft = 509 6 ExplicitTop = 223 5 7 PixelsPerInch = 96 6 8 TextHeight = 13 … … 15 17 Width = 65 16 18 Caption = 'Exam Section' 19 ExplicitWidth = 65 17 20 end 18 21 inherited btnOK: TBitBtn … … 47 50 TabOrder = 3 48 51 end 52 object cboExamResults: TORComboBox [9] 53 Tag = 60 54 Left = 490 55 Top = 280 56 Width = 121 57 Height = 21 58 Style = orcsDropDown 59 AutoSelect = True 60 Caption = 'Results' 61 Color = clWindow 62 DropDownCount = 8 63 Enabled = False 64 ItemHeight = 13 65 ItemTipColor = clWindow 66 ItemTipEnable = True 67 ListItemsOnly = False 68 LongList = False 69 LookupPiece = 0 70 MaxLength = 0 71 Pieces = '2' 72 Sorted = False 73 SynonymChars = '<>' 74 TabOrder = 4 75 OnChange = cboExamResultsChange 76 CharsNeedMatch = 1 77 end 49 78 inherited btnRemove: TButton 50 79 TabOrder = 5 … … 71 100 end 72 101 end 73 object cboExamResults: TORComboBox 74 Tag = 60 75 Left = 490 76 Top = 280 77 Width = 121 78 Height = 21 79 Style = orcsDropDown 80 AutoSelect = True 81 Caption = 'Results' 82 Color = clWindow 83 DropDownCount = 8 84 Enabled = False 85 ItemHeight = 13 86 ItemTipColor = clWindow 87 ItemTipEnable = True 88 ListItemsOnly = False 89 LongList = False 90 MaxLength = 0 91 Pieces = '2' 92 Sorted = False 93 SynonymChars = '<>' 94 TabOrder = 4 95 OnChange = cboExamResultsChange 102 inherited amgrMain: TVA508AccessibilityManager 103 Data = ( 104 ( 105 'Component = cboExamResults' 106 'Label = lblExamResults' 107 'Status = stsOK') 108 ( 109 'Component = edtComment' 110 'Label = lblComment' 111 'Status = stsOK') 112 ( 113 'Component = btnRemove' 114 'Status = stsDefault') 115 ( 116 'Component = btnSelectAll' 117 'Status = stsDefault') 118 ( 119 'Component = pnlMain' 120 'Status = stsDefault') 121 ( 122 'Component = lbxSection' 123 'Label = lblList' 124 'Status = stsOK') 125 ( 126 'Component = pnlLeft' 127 'Status = stsDefault') 128 ( 129 'Component = lbSection' 130 'Label = lblSection' 131 'Status = stsOK') 132 ( 133 'Component = btnOther' 134 'Status = stsDefault') 135 ( 136 'Component = pnlGrid' 137 'Status = stsDefault') 138 ( 139 'Component = lbGrid' 140 'Status = stsDefault') 141 ( 142 'Component = hcGrid' 143 'Status = stsDefault') 144 ( 145 'Component = btnOK' 146 'Status = stsDefault') 147 ( 148 'Component = btnCancel' 149 'Status = stsDefault') 150 ( 151 'Component = frmExams' 152 'Status = stsDefault')) 96 153 end 97 154 end -
cprs/trunk/CPRS-Chart/Encounter/fExam.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn, 8 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain ;8 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager; 9 9 10 10 type … … 29 29 30 30 uses 31 fEncounterFrame ;31 fEncounterFrame, VA508AccessibilityRouter; 32 32 33 33 procedure TfrmExams.cboExamResultsChange(Sender: TObject); … … 114 114 end; 115 115 116 initialization 117 SpecifyFormIsNotADialog(TfrmExams); 118 116 119 end. 117 120 -
cprs/trunk/CPRS-Chart/Encounter/fGAF.dfm
r456 r829 5 5 Caption = 'frmGAF' 6 6 OnActivate = FormActivate 7 ExplicitLeft = 8 8 ExplicitTop = 8 7 9 PixelsPerInch = 96 8 10 TextHeight = 13 … … 34 36 Height = 13 35 37 Align = alTop 38 ExplicitWidth = 3 36 39 end 37 40 object Spacer2: TLabel [4] … … 41 44 Height = 13 42 45 Align = alTop 46 ExplicitWidth = 3 43 47 end 44 48 object lblGAF: TStaticText [5] … … 88 92 Align = alTop 89 93 TabOrder = 0 94 ExplicitLeft = 0 95 ExplicitTop = 35 96 ExplicitWidth = 624 90 97 inherited lbGrid: TORListBox 91 98 Width = 624 … … 94 101 Caption = 'Most recent Global Assessment of Functioning (GAF) scores' 95 102 Pieces = '1,2,3,4' 103 ExplicitWidth = 624 96 104 end 97 105 inherited hcGrid: THeaderControl … … 122 130 Width = 60 123 131 end> 132 ExplicitWidth = 624 124 133 end 125 134 end 126 object edtScore: TCaptionEdit 135 object edtScore: TCaptionEdit [10] 127 136 Left = 226 128 137 Top = 171 … … 134 143 Caption = 'Score' 135 144 end 136 object udScore: TUpDown 145 object udScore: TUpDown [11] 137 146 Left = 259 138 147 Top = 171 … … 140 149 Height = 21 141 150 Associate = edtScore 142 Min = 0143 Position = 0144 151 TabOrder = 2 145 Wrap = False 146 end 147 object dteGAF: TORDateBox 152 end 153 object dteGAF: TORDateBox [12] 148 154 Left = 226 149 155 Top = 202 … … 156 162 Caption = 'Date Determined:' 157 163 end 158 object cboGAFProvider: TORComboBox 164 object cboGAFProvider: TORComboBox [13] 159 165 Left = 226 160 166 Top = 233 … … 179 185 OnExit = cboGAFProviderExit 180 186 OnNeedData = cboGAFProviderNeedData 181 end 182 object btnURL: TButton 187 CharsNeedMatch = 1 188 end 189 object btnURL: TButton [14] 183 190 Left = 3 184 191 Top = 376 … … 192 199 OnClick = btnURLClick 193 200 end 201 inherited amgrMain: TVA508AccessibilityManager 202 Data = ( 203 ( 204 'Component = lblGAF' 205 'Status = stsDefault') 206 ( 207 'Component = lblEntry' 208 'Status = stsDefault') 209 ( 210 'Component = edtScore' 211 'Status = stsDefault') 212 ( 213 'Component = udScore' 214 'Status = stsDefault') 215 ( 216 'Component = dteGAF' 217 'Status = stsDefault') 218 ( 219 'Component = cboGAFProvider' 220 'Status = stsDefault') 221 ( 222 'Component = btnURL' 223 'Status = stsDefault') 224 ( 225 'Component = pnlGrid' 226 'Status = stsDefault') 227 ( 228 'Component = lbGrid' 229 'Status = stsDefault') 230 ( 231 'Component = hcGrid' 232 'Status = stsDefault') 233 ( 234 'Component = btnOK' 235 'Status = stsDefault') 236 ( 237 'Component = btnCancel' 238 'Status = stsDefault') 239 ( 240 'Component = frmGAF' 241 'Status = stsDefault')) 242 end 194 243 end -
cprs/trunk/CPRS-Chart/Encounter/fGAF.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, StdCtrls, Buttons, ExtCtrls, Grids, ORFn, ORNet, ORCtrls, 8 ORDtTm, ComCtrls, fPCEBaseGrid, Menus ;8 ORDtTm, ComCtrls, fPCEBaseGrid, Menus, VA508AccessibilityManager; 9 9 10 10 type … … 47 47 implementation 48 48 49 uses rPCE, rCore, uCore, uPCE, fEncounterFrame ;49 uses rPCE, rCore, uCore, uPCE, fEncounterFrame, VA508AccessibilityRouter; 50 50 51 51 {$R *.DFM} … … 202 202 FTabName := CT_GAFNm; 203 203 btnURL.Visible := (User.WebAccess and (GAFURL <> '')); 204 end; 204 FormActivate(Sender); 205 end; 206 207 initialization 208 SpecifyFormIsNotADialog(TfrmGAF); 205 209 206 210 end. -
cprs/trunk/CPRS-Chart/Encounter/fHFSearch.dfm
r456 r829 2 2 Left = 286 3 3 Top = 248 4 Width = 3635 Height = 4176 4 Caption = 'Other Health Factors' 5 ClientHeight = 390 6 ClientWidth = 355 7 7 Position = poScreenCenter 8 8 OnCreate = FormCreate 9 ExplicitWidth = 363 10 ExplicitHeight = 417 9 11 PixelsPerInch = 96 10 12 TextHeight = 13 11 object splMain: TSplitter 13 object splMain: TSplitter [0] 12 14 Left = 0 13 15 Top = 131 … … 17 19 Align = alTop 18 20 end 19 object lblCat: TLabel 21 object lblCat: TLabel [1] 20 22 Left = 0 21 23 Top = 0 … … 24 26 Align = alTop 25 27 Caption = 'Category:' 28 ExplicitWidth = 45 26 29 end 27 object cbxSearch: TORComboBox 30 object cbxSearch: TORComboBox [2] 28 31 Left = 0 29 32 Top = 13 … … 41 44 ListItemsOnly = True 42 45 LongList = False 46 LookupPiece = 0 43 47 MaxLength = 0 44 48 Pieces = '2' … … 49 53 OnChange = cbxSearchChange 50 54 OnDblClick = tvSearchDblClick 55 CharsNeedMatch = 1 51 56 end 52 object tvSearch: TORTreeView 57 object tvSearch: TORTreeView [3] 53 58 Left = 0 54 59 Top = 134 … … 57 62 Align = alClient 58 63 HideSelection = False 64 Images = dmodShared.imgTemplates 59 65 Indent = 23 60 66 ReadOnly = True 61 StateImages = dmodShared.imgTemplates62 67 TabOrder = 1 63 68 OnChange = tvSearchChange … … 67 72 OnGetImageIndex = tvSearchGetImageIndex 68 73 OnGetSelectedIndex = tvSearchGetImageIndex 69 Caption = ' Other Health Factors'74 Caption = 'Health Factors Category' 70 75 NodePiece = 2 76 ExplicitTop = 137 71 77 end 72 object pnlBottom: TPanel 78 object pnlBottom: TPanel [4] 73 79 Left = 0 74 80 Top = 363 … … 78 84 BevelOuter = bvNone 79 85 TabOrder = 2 86 DesignSize = ( 87 355 88 27) 80 89 object btnOK: TButton 81 90 Left = 196 … … 102 111 end 103 112 end 113 inherited amgrMain: TVA508AccessibilityManager 114 Left = 176 115 Data = ( 116 ( 117 'Component = cbxSearch' 118 'Status = stsDefault') 119 ( 120 'Component = tvSearch' 121 'Status = stsDefault') 122 ( 123 'Component = pnlBottom' 124 'Status = stsDefault') 125 ( 126 'Component = btnOK' 127 'Status = stsDefault') 128 ( 129 'Component = btnCancel' 130 'Status = stsDefault') 131 ( 132 'Component = frmHFSearch' 133 'Status = stsDefault')) 134 end 135 object imgListHFtvSearch: TVA508ImageListLabeler 136 Components = < 137 item 138 Component = tvSearch 139 end> 140 Labels = <> 141 RemoteLabeler = dmodShared.imgLblHealthFactorLabels 142 Left = 224 143 end 104 144 end -
cprs/trunk/CPRS-Chart/Encounter/fHFSearch.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls; 7 fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls, 8 VA508AccessibilityManager, VA508ImageListLabeler; 8 9 9 10 type … … 16 17 splMain: TSplitter; 17 18 lblCat: TLabel; 19 imgListHFtvSearch: TVA508ImageListLabeler; 18 20 procedure FormCreate(Sender: TObject); 19 21 procedure btnOKClick(Sender: TObject); … … 115 117 HFList: TStringList; 116 118 i: integer; 117 Node :TORTreeNode;119 Node, Child :TORTreeNode; 118 120 CAT: string; 119 121 … … 135 137 begin 136 138 StringData := HFList[i]; 137 StateIndex := 2; 139 ImageIndex := 2; 140 SelectedIndex := 2; 138 141 end; 139 142 end; … … 151 154 Node := TORTreeNode(Node.GetNextSibling); 152 155 end; 153 TORTreeNode(tvSearch.Items.AddChild(Node, '')).StringData := Pieces(HFList[i],U,1,2); 156 Child := TORTreeNode(tvSearch.Items.AddChild(Node, '')); 157 Child.StringData := Pieces(HFList[i],U,1,2); 158 Child.ImageIndex := -1; 159 Child.StateIndex := -1; 154 160 end; 155 161 end; … … 181 187 begin 182 188 if(Node.Expanded) then 183 Node. StateIndex := 3189 Node.ImageIndex := 3 184 190 else 185 Node.StateIndex := 2; 186 end; 191 Node.ImageIndex := 2; 192 end 193 else 194 Node.ImageIndex := -1; 195 Node.SelectedIndex := Node.ImageIndex; 187 196 // tvSearch.Invalidate; 188 197 end; -
cprs/trunk/CPRS-Chart/Encounter/fHealthFactor.dfm
r456 r829 3 3 Top = 205 4 4 Caption = 'Health Factor page' 5 ExplicitLeft = 374 6 ExplicitTop = 205 5 7 PixelsPerInch = 96 6 8 TextHeight = 13 … … 15 17 Width = 103 16 18 Caption = 'Health Factor Section' 19 ExplicitWidth = 103 17 20 end 18 21 inherited btnOK: TBitBtn … … 49 52 TabOrder = 3 50 53 end 51 inherited btnRemove: TButton 52 TabOrder = 5 53 end 54 inherited btnSelectAll: TButton 55 TabOrder = 2 56 TabStop = True 57 end 58 inherited pnlMain: TPanel 59 TabOrder = 0 60 inherited lbxSection: TORListBox 61 Tag = 70 62 end 63 inherited pnlLeft: TPanel 64 inherited lbSection: TORListBox 65 Tag = 70 66 TabOrder = 0 67 Caption = 'Health Factor Section' 68 end 69 inherited btnOther: TButton 70 Tag = 23 71 Caption = 'Other Health Factor...' 72 TabOrder = 1 73 end 74 end 75 end 76 object cboHealthLevel: TORComboBox 54 object cboHealthLevel: TORComboBox [9] 77 55 Tag = 50 78 56 Left = 490 … … 100 78 CharsNeedMatch = 1 101 79 end 80 inherited btnRemove: TButton 81 TabOrder = 5 82 end 83 inherited btnSelectAll: TButton 84 TabOrder = 2 85 TabStop = True 86 end 87 inherited pnlMain: TPanel 88 TabOrder = 0 89 inherited lbxSection: TORListBox 90 Tag = 70 91 ExplicitLeft = 210 92 end 93 inherited pnlLeft: TPanel 94 inherited lbSection: TORListBox 95 Tag = 70 96 TabOrder = 0 97 Caption = 'Health Factor Section' 98 end 99 inherited btnOther: TButton 100 Tag = 23 101 Caption = 'Other Health Factor...' 102 TabOrder = 1 103 end 104 end 105 end 106 inherited amgrMain: TVA508AccessibilityManager 107 Data = ( 108 ( 109 'Component = cboHealthLevel' 110 'Label = lblHealthLevel' 111 'Status = stsOK') 112 ( 113 'Component = edtComment' 114 'Label = lblComment' 115 'Status = stsOK') 116 ( 117 'Component = btnRemove' 118 'Status = stsDefault') 119 ( 120 'Component = btnSelectAll' 121 'Status = stsDefault') 122 ( 123 'Component = pnlMain' 124 'Status = stsDefault') 125 ( 126 'Component = lbxSection' 127 'Label = lblList' 128 'Status = stsOK') 129 ( 130 'Component = pnlLeft' 131 'Status = stsDefault') 132 ( 133 'Component = lbSection' 134 'Label = lblSection' 135 'Status = stsOK') 136 ( 137 'Component = btnOther' 138 'Status = stsDefault') 139 ( 140 'Component = pnlGrid' 141 'Status = stsDefault') 142 ( 143 'Component = lbGrid' 144 'Status = stsDefault') 145 ( 146 'Component = hcGrid' 147 'Status = stsDefault') 148 ( 149 'Component = btnOK' 150 'Status = stsDefault') 151 ( 152 'Component = btnCancel' 153 'Status = stsDefault') 154 ( 155 'Component = frmHealthFactors' 156 'Status = stsDefault')) 157 end 102 158 end -
cprs/trunk/CPRS-Chart/Encounter/fHealthFactor.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn, 8 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain ;8 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager; 9 9 10 10 type … … 30 30 31 31 uses 32 fEncounterFrame ;32 fEncounterFrame, VA508AccessibilityRouter; 33 33 34 34 procedure tfrmHealthFactors.cboHealthLevelChange(Sender: TObject); … … 115 115 end; 116 116 117 initialization 118 SpecifyFormIsNotADialog(TfrmHealthFactors); 119 117 120 end. -
cprs/trunk/CPRS-Chart/Encounter/fImmunization.dfm
r456 r829 3 3 Top = 169 4 4 Caption = 'Encouner Immunization' 5 ExplicitLeft = 373 6 ExplicitTop = 169 5 7 PixelsPerInch = 96 6 8 TextHeight = 13 … … 22 24 Width = 100 23 25 Caption = 'Immunization Section' 26 ExplicitWidth = 100 24 27 end 25 28 object lblContra: TLabel [6] … … 75 78 TabOrder = 3 76 79 end 77 inherited btnRemove: TButton 78 TabOrder = 7 79 end 80 inherited btnSelectAll: TButton 81 TabOrder = 2 82 TabStop = True 83 end 84 inherited pnlMain: TPanel 85 TabOrder = 0 86 inherited lbxSection: TORListBox 87 Tag = 40 88 end 89 inherited pnlLeft: TPanel 90 inherited lbSection: TORListBox 91 Tag = 40 92 TabOrder = 0 93 Caption = 'Immunization Section' 94 end 95 inherited btnOther: TButton 96 Tag = 20 97 Caption = 'Other Immunization...' 98 TabOrder = 1 99 end 100 end 101 end 102 object cboImmReaction: TORComboBox 80 object cboImmReaction: TORComboBox [11] 103 81 Tag = 20 104 82 Left = 490 … … 117 95 ListItemsOnly = False 118 96 LongList = False 97 LookupPiece = 0 119 98 MaxLength = 0 120 99 Pieces = '2' … … 123 102 TabOrder = 5 124 103 OnChange = cboImmReactionChange 125 end 126 object cboImmSeries: TORComboBox 104 CharsNeedMatch = 1 105 end 106 object cboImmSeries: TORComboBox [12] 127 107 Tag = 10 128 108 Left = 490 … … 141 121 ListItemsOnly = False 142 122 LongList = False 123 LookupPiece = 0 143 124 MaxLength = 0 144 125 Pieces = '2' … … 147 128 TabOrder = 4 148 129 OnChange = cboImmSeriesChange 149 end 150 object ckbContra: TCheckBox 130 CharsNeedMatch = 1 131 end 132 object ckbContra: TCheckBox [13] 151 133 Left = 490 152 134 Top = 319 … … 157 139 OnClick = ckbContraClick 158 140 end 141 inherited btnRemove: TButton 142 TabOrder = 7 143 end 144 inherited btnSelectAll: TButton 145 TabOrder = 2 146 TabStop = True 147 end 148 inherited pnlMain: TPanel 149 TabOrder = 0 150 inherited lbxSection: TORListBox 151 Tag = 40 152 end 153 inherited pnlLeft: TPanel 154 inherited lbSection: TORListBox 155 Tag = 40 156 TabOrder = 0 157 Caption = 'Immunization Section' 158 end 159 inherited btnOther: TButton 160 Tag = 20 161 Caption = 'Other Immunization...' 162 TabOrder = 1 163 end 164 end 165 end 166 inherited amgrMain: TVA508AccessibilityManager 167 Data = ( 168 ( 169 'Component = cboImmReaction' 170 'Label = lblReaction' 171 'Status = stsOK') 172 ( 173 'Component = cboImmSeries' 174 'Label = lblSeries' 175 'Status = stsOK') 176 ( 177 'Component = ckbContra' 178 'Status = stsDefault') 179 ( 180 'Component = edtComment' 181 'Label = lblComment' 182 'Status = stsOK') 183 ( 184 'Component = btnRemove' 185 'Status = stsDefault') 186 ( 187 'Component = btnSelectAll' 188 'Status = stsDefault') 189 ( 190 'Component = pnlMain' 191 'Status = stsDefault') 192 ( 193 'Component = lbxSection' 194 'Label = lblList' 195 'Status = stsOK') 196 ( 197 'Component = pnlLeft' 198 'Status = stsDefault') 199 ( 200 'Component = lbSection' 201 'Label = lblSection' 202 'Status = stsOK') 203 ( 204 'Component = btnOther' 205 'Status = stsDefault') 206 ( 207 'Component = pnlGrid' 208 'Status = stsDefault') 209 ( 210 'Component = lbGrid' 211 'Status = stsDefault') 212 ( 213 'Component = hcGrid' 214 'Status = stsDefault') 215 ( 216 'Component = btnOK' 217 'Status = stsDefault') 218 ( 219 'Component = btnCancel' 220 'Status = stsDefault') 221 ( 222 'Component = frmImmunizations' 223 'Status = stsDefault')) 224 end 159 225 end -
cprs/trunk/CPRS-Chart/Encounter/fImmunization.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn, 8 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain ;8 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager; 9 9 10 10 type … … 37 37 38 38 uses 39 fEncounterFrame ;39 fEncounterFrame, VA508AccessibilityRouter; 40 40 41 41 procedure TfrmImmunizations.cboImmSeriesChange(Sender: TObject); … … 178 178 end; 179 179 180 initialization 181 SpecifyFormIsNotADialog(TfrmImmunizations); 182 180 183 end. 181 -
cprs/trunk/CPRS-Chart/Encounter/fPCEBase.dfm
r456 r829 1 objectfrmPCEBase: TfrmPCEBase1 inherited frmPCEBase: TfrmPCEBase 2 2 Left = 194 3 3 Top = 170 4 AutoScroll = False5 4 Caption = 'Basic Page' 6 5 ClientHeight = 400 7 6 ClientWidth = 624 8 Color = clBtnFace9 Font.Charset = DEFAULT_CHARSET10 Font.Color = clWindowText11 Font.Height = -1112 Font.Name = 'MS Sans Serif'13 Font.Style = []14 OldCreateOrder = True15 7 OnClose = FormClose 16 8 OnCreate = FormCreate 17 OnShow = FormShow 9 ExplicitWidth = 320 10 ExplicitHeight = 240 18 11 DesignSize = ( 19 12 624 … … 21 14 PixelsPerInch = 96 22 15 TextHeight = 13 23 object btnOK: TBitBtn 16 object btnOK: TBitBtn [0] 24 17 Left = 467 25 18 Top = 376 … … 27 20 Height = 21 28 21 Anchors = [akRight, akBottom] 29 Caption = ' OK'22 Caption = '&OK' 30 23 ModalResult = 1 31 24 TabOrder = 0 … … 33 26 NumGlyphs = 2 34 27 end 35 object btnCancel: TBitBtn 28 object btnCancel: TBitBtn [1] 36 29 Left = 547 37 30 Top = 376 … … 39 32 Height = 21 40 33 Anchors = [akRight, akBottom] 41 Caption = ' Cancel'34 Caption = '&Cancel' 42 35 ModalResult = 2 43 36 TabOrder = 1 … … 45 38 NumGlyphs = 2 46 39 end 40 inherited amgrMain: TVA508AccessibilityManager 41 Data = ( 42 ( 43 'Component = btnOK' 44 'Status = stsDefault') 45 ( 46 'Component = btnCancel' 47 'Status = stsDefault') 48 ( 49 'Component = frmPCEBase' 50 'Status = stsDefault')) 51 end 47 52 end -
cprs/trunk/CPRS-Chart/Encounter/fPCEBase.pas
r456 r829 17 17 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, uConst, 18 18 StdCtrls, fAutoSz, Buttons, ORCtrls, ORFn, uPCE, ORDtTm, Checklst, 19 ComCtrls ;19 ComCtrls, VA508AccessibilityManager, fBase508Form; 20 20 21 21 type … … 27 27 procedure btnOKClick(Sender: TObject); virtual; 28 28 procedure FormClose(Sender: TObject; var Action: TCloseAction); 29 procedure FormShow(Sender: TObject);30 29 private 31 30 FDisplayCount: Integer; // number of times page displayed … … 71 70 72 71 uses 73 fEncounterFrame ;72 fEncounterFrame, VA508AccessibilityRouter; 74 73 75 74 … … 368 367 end; 369 368 370 procedure TfrmPCEBase.FormShow(Sender: TObject); 371 begin 372 inherited; 373 FocusFirstControl; 374 end; 369 initialization 370 SpecifyFormIsNotADialog(TfrmPCEBase); 371 375 372 376 373 end. -
cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.dfm
r456 r829 1 1 inherited frmPCEBaseGrid: TfrmPCEBaseGrid 2 Left = 2003 Top = 3032 Left = 128 3 Top = 192 4 4 Caption = 'frmPCEBaseGrid' 5 ExplicitLeft = 128 6 ExplicitTop = 192 5 7 PixelsPerInch = 96 6 8 TextHeight = 13 7 object pnlGrid: TPanel 9 object pnlGrid: TPanel [2] 8 10 Left = 6 9 11 Top = 238 … … 11 13 Height = 87 12 14 BevelOuter = bvNone 13 Caption = 'pnlGrid'14 15 TabOrder = 2 15 16 OnResize = pnlGridResize … … 34 35 Width = 451 35 36 Height = 17 36 DragReorder = False37 37 Sections = < 38 38 item … … 47 47 end 48 48 end 49 inherited amgrMain: TVA508AccessibilityManager 50 Data = ( 51 ( 52 'Component = pnlGrid' 53 'Status = stsDefault') 54 ( 55 'Component = lbGrid' 56 'Status = stsDefault') 57 ( 58 'Component = hcGrid' 59 'Status = stsDefault') 60 ( 61 'Component = btnOK' 62 'Status = stsDefault') 63 ( 64 'Component = btnCancel' 65 'Status = stsDefault') 66 ( 67 'Component = frmPCEBaseGrid' 68 'Status = stsDefault')) 69 end 49 70 end -
cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn; 7 fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn, 8 VA508AccessibilityManager; 8 9 9 10 type … … 38 39 implementation 39 40 41 uses 42 VA2006Utils, VA508AccessibilityRouter; 43 40 44 {$R *.DFM} 41 45 … … 46 50 begin 47 51 inherited; 48 lbGrid.Color := ReadOnlyColor; 49 lbGrid.ItemTipColor := ReadOnlyColor; 52 FixHeaderControlDelphi2006Bug(hcGrid); 50 53 FSectionGap := 15; 51 54 SyncGridHeader(TRUE); … … 223 226 end; 224 227 228 initialization 229 SpecifyFormIsNotADialog(TfrmPCEBaseGrid); 230 225 231 end. -
cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.dfm
r456 r829 3 3 Top = 166 4 4 Caption = 'frmPCEBaseMain' 5 OnDestroy = FormDestroy6 OnResize = FormResize5 ExplicitWidth = 320 6 ExplicitHeight = 240 7 7 PixelsPerInch = 96 8 8 TextHeight = 13 … … 37 37 Left = 464 38 38 TabOrder = 1 39 ExplicitLeft = 464 39 40 end 40 41 inherited btnCancel: TBitBtn 41 42 Left = 544 42 43 TabOrder = 2 44 ExplicitLeft = 544 43 45 end 44 46 inherited pnlGrid: TPanel 45 47 Width = 475 46 48 TabOrder = 0 49 ExplicitWidth = 475 47 50 inherited lbGrid: TORListBox 48 51 Width = 475 49 52 MultiSelect = True 50 53 OnClick = lbGridSelect 54 OnExit = lbGridExit 51 55 OnChange = lbGridSelect 52 56 CheckEntireLine = True 57 ExplicitWidth = 475 53 58 end 54 59 inherited hcGrid: THeaderControl 55 60 Width = 475 56 end 57 end 58 object edtComment: TCaptionEdit 61 ExplicitWidth = 475 62 end 63 end 64 object edtComment: TCaptionEdit [7] 59 65 Left = 6 60 66 Top = 343 … … 67 73 Caption = 'Comments' 68 74 end 69 object btnRemove: TButton 75 object btnRemove: TButton [8] 70 76 Left = 536 71 77 Top = 343 … … 76 82 OnClick = btnRemoveClick 77 83 end 78 object btnSelectAll: TButton 84 object btnSelectAll: TButton [9] 79 85 Left = 406 80 86 Top = 326 … … 86 92 OnClick = btnSelectAllClick 87 93 end 88 object pnlMain: TPanel 94 object pnlMain: TPanel [10] 89 95 Left = 6 90 96 Top = 20 … … 97 103 Left = 204 98 104 Top = 0 99 Width = 3100 105 Height = 204 101 Cursor = crHSplit102 106 OnMoved = splLeftMoved 103 107 end … … 115 119 TabOrder = 1 116 120 OnClick = clbListClick 121 OnExit = lbxSectionExit 117 122 OnMouseDown = clbListMouseDown 118 123 Caption = 'Section Name' … … 147 152 TabOrder = 1 148 153 OnClick = lbSectionClick 154 OnExit = lbSectionExit 149 155 Caption = 'Section' 150 156 ItemTipColor = clWindow … … 152 158 Pieces = '3' 153 159 CheckEntireLine = True 160 ExplicitLeft = -3 161 ExplicitTop = -2 154 162 end 155 163 object btnOther: TButton … … 162 170 TabOrder = 0 163 171 OnClick = btnOtherClick 172 OnExit = btnOtherExit 164 173 end 165 174 end 166 175 end 176 inherited amgrMain: TVA508AccessibilityManager 177 Left = 24 178 Top = 24 179 Data = ( 180 ( 181 'Component = edtComment' 182 'Label = lblComment' 183 'Status = stsOK') 184 ( 185 'Component = btnRemove' 186 'Status = stsDefault') 187 ( 188 'Component = btnSelectAll' 189 'Status = stsDefault') 190 ( 191 'Component = pnlMain' 192 'Status = stsDefault') 193 ( 194 'Component = lbxSection' 195 'Label = lblList' 196 'Status = stsOK') 197 ( 198 'Component = pnlLeft' 199 'Status = stsDefault') 200 ( 201 'Component = lbSection' 202 'Label = lblSection' 203 'Status = stsOK') 204 ( 205 'Component = btnOther' 206 'Status = stsDefault') 207 ( 208 'Component = pnlGrid' 209 'Status = stsDefault') 210 ( 211 'Component = lbGrid' 212 'Status = stsDefault') 213 ( 214 'Component = hcGrid' 215 'Status = stsDefault') 216 ( 217 'Component = btnOK' 218 'Status = stsDefault') 219 ( 220 'Component = btnCancel' 221 'Status = stsDefault') 222 ( 223 'Component = frmPCEBaseMain' 224 'Status = stsDefault')) 225 end 167 226 end -
cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.pas
r456 r829 1 1 unit fPCEBaseMain; 2 {Warning: The tab order has been changed in the OnExit event of several controls. 3 To change the tab order of lbSection, lbxSection, and btnOther you must do it programatically.} 2 4 3 5 interface … … 6 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 9 fPCEBaseGrid, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, rPCE, uPCE, 8 CheckLst, ORFn ;10 CheckLst, ORFn, VA508AccessibilityManager; 9 11 10 12 type … … 41 43 procedure splLeftMoved(Sender: TObject); 42 44 procedure edtCommentKeyPress(Sender: TObject; var Key: Char); 45 procedure lbSectionExit(Sender: TObject); 46 procedure btnOtherExit(Sender: TObject); 47 procedure lbxSectionExit(Sender: TObject); 48 procedure lbGridExit(Sender: TObject); 49 procedure FormCreate(Sender: TObject); 43 50 private 44 51 FCommentItem: integer; 45 52 FCommentChanged: boolean; 46 53 FUpdateCount: integer; 54 FSectionPopulated: boolean; 47 55 //FUpdatingGrid: boolean; moved to 'protected' so frmDiagnoses can see it (RV) 48 56 protected … … 77 85 implementation 78 86 79 uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch; 87 uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch, VA508AccessibilityRouter, 88 ORCtrlsVA508Compatibility, fBase508Form; 80 89 81 90 {$R *.DFM} 91 92 type 93 TLBSectionManager = class(TORListBox508Manager) 94 public 95 function GetItemInstructions(Component: TWinControl): string; override; 96 function GetState(Component: TWinControl): string; override; 97 end; 82 98 83 99 procedure TfrmPCEBaseMain.lbSectionClick(Sender: TObject); … … 87 103 FPCEListCodesProc(lbxSection.Items, lbSection.ItemIEN); 88 104 CheckOffEntries; 105 FSectionPopulated := TRUE; 106 end; 107 108 procedure TfrmPCEBaseMain.lbSectionExit(Sender: TObject); 109 begin 110 inherited; 111 if TabIsPressed then 112 if lbxSection.CanFocus then 113 lbxSection.SetFocus; 89 114 end; 90 115 … … 102 127 try 103 128 SaveGridSelected; 104 tmpList.Assign(lbGrid.Items);129 FastAssign(lbGrid.Items, tmpList); 105 130 for i := 0 to lbGrid.Items.Count-1 do 106 131 begin … … 109 134 tmpList.Objects[i] := lbGrid.Items.Objects[i]; 110 135 end; 111 lbGrid.Items.Assign(tmpList); 136 //FastAssign(tmpList,lbGrid.Items); //cq: 13228 Causin a/v errors. 137 lbGrid.Items.Assign(tmpList); //cq: 13228 112 138 RestoreGridSelected; 113 139 SyncGridData; … … 155 181 end; 156 182 183 procedure TfrmPCEBaseMain.btnOtherExit(Sender: TObject); 184 begin 185 inherited; 186 if TabIsPressed then begin 187 if lbGrid.CanFocus then 188 lbGrid.SetFocus 189 end 190 else if ShiftTabIsPressed then 191 if lbxSection.CanFocus then 192 lbxSection.SetFocus; 193 end; 194 157 195 procedure TfrmPCEBaseMain.edtCommentExit(Sender: TObject); 158 196 begin … … 240 278 end; 241 279 280 procedure TfrmPCEBaseMain.lbGridExit(Sender: TObject); 281 begin 282 inherited; 283 if ShiftTabIsPressed then 284 if btnOther.CanFocus then 285 btnOther.SetFocus; 286 end; 287 242 288 procedure TfrmPCEBaseMain.lbGridSelect(Sender: TObject); 243 289 begin … … 245 291 // clbList.ItemIndex := -1; 246 292 UpdateControls; 293 end; 294 295 procedure TfrmPCEBaseMain.FormCreate(Sender: TObject); 296 begin 297 inherited FormCreate(Sender); 298 lbxSection.HideSelection := TRUE; 299 amgrMain.ComponentManager[lbSection] := TLBSectionManager.Create; 247 300 end; 248 301 … … 413 466 end; 414 467 468 procedure TfrmPCEBaseMain.lbxSectionExit(Sender: TObject); 469 begin 470 inherited; 471 if TabIsPressed then begin 472 if btnOther.CanFocus then 473 btnOther.SetFocus 474 end 475 else if ShiftTabIsPressed then 476 if lbSection.CanFocus then 477 lbSection.SetFocus; 478 end; 479 415 480 procedure TfrmPCEBaseMain.UpdateTabPos; 416 481 begin … … 503 568 end; 504 569 570 { TLBSectionManager } 571 572 function TLBSectionManager.GetItemInstructions(Component: TWinControl): string; 573 var 574 lb : TORListBox; 575 idx: integer; 576 begin 577 lb := TORListBox(Component); 578 idx := lb.ItemIndex; 579 if (idx >= 0) and lb.Selected[idx] then 580 Result := 'Press space bar to populate ' + 581 TfrmPCEBaseMain(Component.Owner).FTabName + ' section' 582 else 583 result := inherited GetItemInstructions(Component); 584 end; 585 586 function TLBSectionManager.GetState(Component: TWinControl): string; 587 var 588 frm: TfrmPCEBaseMain; 589 begin 590 Result := ''; 591 frm := TfrmPCEBaseMain(Component.Owner); 592 if frm.FSectionPopulated then 593 begin 594 frm.FSectionPopulated := FALSE; 595 Result := frm.FTabName + ' section populated with ' + 596 inttostr(frm.lbxSection.Count) + ' items'; 597 end; 598 end; 599 600 initialization 601 SpecifyFormIsNotADialog(TfrmPCEBaseMain); 602 505 603 end. -
cprs/trunk/CPRS-Chart/Encounter/fPCEEdit.dfm
r456 r829 1 objectfrmPCEEdit: TfrmPCEEdit1 inherited frmPCEEdit: TfrmPCEEdit 2 2 Left = 214 3 3 Top = 107 … … 6 6 ClientHeight = 128 7 7 ClientWidth = 543 8 Color = clBtnFace9 Font.Charset = DEFAULT_CHARSET10 Font.Color = clWindowText11 Font.Height = -1112 Font.Name = 'MS Sans Serif'13 Font.Style = []14 OldCreateOrder = False15 8 Position = poScreenCenter 16 9 OnCreate = FormCreate … … 20 13 PixelsPerInch = 96 21 14 TextHeight = 13 22 object Label1: TStaticText 15 object Label1: TStaticText [0] 23 16 Left = 0 24 17 Top = 0 … … 35 28 ParentFont = False 36 29 TabOrder = 5 30 ExplicitWidth = 201 37 31 end 38 object lblNew: TMemo 32 object lblNew: TMemo [1] 39 33 Left = 136 40 34 Top = 32 … … 48 42 TabOrder = 3 49 43 end 50 object lblNote: TMemo 44 object lblNote: TMemo [2] 51 45 Left = 136 52 46 Top = 73 … … 60 54 TabOrder = 4 61 55 end 62 object btnNew: TButton 56 object btnNew: TButton [3] 63 57 Left = 8 64 58 Top = 28 … … 69 63 TabOrder = 0 70 64 end 71 object btnNote: TButton 65 object btnNote: TButton [4] 72 66 Left = 8 73 67 Top = 69 … … 78 72 TabOrder = 1 79 73 end 80 object btnCancel: TButton 74 object btnCancel: TButton [5] 81 75 Left = 465 82 76 Top = 104 … … 89 83 TabOrder = 2 90 84 end 85 inherited amgrMain: TVA508AccessibilityManager 86 Data = ( 87 ( 88 'Component = Label1' 89 'Status = stsDefault') 90 ( 91 'Component = lblNew' 92 'Status = stsDefault') 93 ( 94 'Component = lblNote' 95 'Status = stsDefault') 96 ( 97 'Component = btnNew' 98 'Status = stsDefault') 99 ( 100 'Component = btnNote' 101 'Status = stsDefault') 102 ( 103 'Component = btnCancel' 104 'Status = stsDefault') 105 ( 106 'Component = frmPCEEdit' 107 'Status = stsDefault')) 108 end 91 109 end -
cprs/trunk/CPRS-Chart/Encounter/fPCEEdit.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORFn, uPCE ;7 StdCtrls, ORFn, uPCE, fBase508Form, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmPCEEdit = class(T Form)10 TfrmPCEEdit = class(TfrmBase508Form) 11 11 btnNew: TButton; 12 12 btnNote: TButton; -
cprs/trunk/CPRS-Chart/Encounter/fPCELex.dfm
r456 r829 5 5 BorderStyle = bsDialog 6 6 Caption = 'Lookup Other Diagnosis' 7 ClientHeight = 275 8 ClientWidth = 429 7 9 Position = poScreenCenter 8 10 OnCreate = FormCreate 11 ExplicitWidth = 320 12 ExplicitHeight = 240 9 13 PixelsPerInch = 96 10 14 TextHeight = 13 11 object lblSearch: TLabel 15 object lblSearch: TLabel [0] 12 16 Left = 6 13 17 Top = 16 … … 16 20 Caption = 'Search for Diagnosis' 17 21 end 18 object lblSelect: TLabel 22 object lblSelect: TLabel [1] 19 23 Left = 6 20 24 Top = 67 … … 24 28 Visible = False 25 29 end 26 object txtSearch: TCaptionEdit 30 object txtSearch: TCaptionEdit [2] 27 31 Left = 6 28 32 Top = 30 … … 33 37 Caption = 'Search for Diagnosis' 34 38 end 35 object cmdSearch: TButton 39 object cmdSearch: TButton [3] 36 40 Left = 346 37 41 Top = 30 … … 43 47 OnClick = cmdSearchClick 44 48 end 45 object cmdOK: TButton 49 object cmdOK: TButton [4] 46 50 Left = 263 47 51 Top = 245 … … 52 56 OnClick = cmdOKClick 53 57 end 54 object cmdCancel: TButton 58 object cmdCancel: TButton [5] 55 59 Left = 346 56 60 Top = 245 … … 62 66 OnClick = cmdCancelClick 63 67 end 64 object lstSelect: TORListBox 68 object lstSelect: TORListBox [6] 65 69 Left = 6 66 70 Top = 81 … … 78 82 Pieces = '2' 79 83 end 84 inherited amgrMain: TVA508AccessibilityManager 85 Data = ( 86 ( 87 'Component = txtSearch' 88 'Status = stsDefault') 89 ( 90 'Component = cmdSearch' 91 'Status = stsDefault') 92 ( 93 'Component = cmdOK' 94 'Status = stsDefault') 95 ( 96 'Component = cmdCancel' 97 'Status = stsDefault') 98 ( 99 'Component = lstSelect' 100 'Status = stsDefault') 101 ( 102 'Component = frmPCELex' 103 'Status = stsDefault')) 104 end 80 105 end -
cprs/trunk/CPRS-Chart/Encounter/fPCELex.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls ;7 fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Encounter/fPCEOther.dfm
r456 r829 1 objectfrmPCEOther: TfrmPCEOther1 inherited frmPCEOther: TfrmPCEOther 2 2 Left = 451 3 3 Top = 201 4 Width = 2795 Height = 3406 4 ActiveControl = cboOther 7 5 Caption = 'OtherItems' 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 6 ClientHeight = 313 7 ClientWidth = 271 15 8 Position = poScreenCenter 16 9 OnCreate = FormCreate 10 ExplicitWidth = 279 11 ExplicitHeight = 340 17 12 PixelsPerInch = 96 18 13 TextHeight = 13 19 object cmdCancel: TButton 14 object cmdCancel: TButton [0] 20 15 Left = 190 21 16 Top = 287 … … 27 22 OnClick = cmdCancelClick 28 23 end 29 object cmdOK: TButton 24 object cmdOK: TButton [1] 30 25 Left = 110 31 26 Top = 287 … … 37 32 OnClick = cmdOKClick 38 33 end 39 object cboOther: TORComboBox 34 object cboOther: TORComboBox [2] 40 35 Left = 8 41 36 Top = 8 … … 52 47 ListItemsOnly = False 53 48 LongList = False 49 LookupPiece = 0 54 50 MaxLength = 0 55 51 Pieces = '2' … … 59 55 OnChange = cboOtherChange 60 56 OnDblClick = cboOtherDblClick 57 CharsNeedMatch = 1 58 end 59 inherited amgrMain: TVA508AccessibilityManager 60 Data = ( 61 ( 62 'Component = cmdCancel' 63 'Status = stsDefault') 64 ( 65 'Component = cmdOK' 66 'Status = stsDefault') 67 ( 68 'Component = cboOther' 69 'Status = stsDefault') 70 ( 71 'Component = frmPCEOther' 72 'Status = stsDefault')) 61 73 end 62 74 end -
cprs/trunk/CPRS-Chart/Encounter/fPCEOther.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, ORFn, ORCtrls, StdCtrls ;7 fAutoSz, ORFn, ORCtrls, StdCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Encounter/fPCEProvider.dfm
r456 r829 1 objectfrmPCEProvider: TfrmPCEProvider1 inherited frmPCEProvider: TfrmPCEProvider 2 2 Left = 192 3 3 Top = 104 … … 7 7 ClientHeight = 254 8 8 ClientWidth = 317 9 Color = clBtnFace10 Font.Charset = DEFAULT_CHARSET11 Font.Color = clWindowText12 Font.Height = -1113 Font.Name = 'MS Sans Serif'14 Font.Style = []15 OldCreateOrder = False16 9 Position = poScreenCenter 17 10 OnCreate = FormCreate 18 11 PixelsPerInch = 96 19 12 TextHeight = 13 20 object Spacer1: TLabel 13 object Spacer1: TLabel [0] 21 14 Left = 0 22 15 Top = 0 … … 24 17 Height = 13 25 18 Align = alTop 19 ExplicitWidth = 3 26 20 end 27 object lblMsg: TMemo 21 object lblMsg: TMemo [1] 28 22 Left = 0 29 23 Top = 13 … … 46 40 TabOrder = 4 47 41 end 48 object cboPrimary: TORComboBox 42 object cboPrimary: TORComboBox [2] 49 43 Left = 6 50 44 Top = 69 … … 73 67 CharsNeedMatch = 1 74 68 end 75 object btnYes: TButton 69 object btnYes: TButton [3] 76 70 Left = 158 77 71 Top = 40 … … 83 77 TabOrder = 1 84 78 end 85 object btnNo: TButton 79 object btnNo: TButton [4] 86 80 Left = 238 87 81 Top = 40 … … 93 87 TabOrder = 2 94 88 end 95 object btnSelect: TButton 89 object btnSelect: TButton [5] 96 90 Left = 6 97 91 Top = 40 … … 102 96 OnClick = btnSelectClick 103 97 end 98 inherited amgrMain: TVA508AccessibilityManager 99 Data = ( 100 ( 101 'Component = lblMsg' 102 'Status = stsDefault') 103 ( 104 'Component = cboPrimary' 105 'Status = stsDefault') 106 ( 107 'Component = btnYes' 108 'Status = stsDefault') 109 ( 110 'Component = btnNo' 111 'Status = stsDefault') 112 ( 113 'Component = btnSelect' 114 'Status = stsDefault') 115 ( 116 'Component = frmPCEProvider' 117 'Status = stsDefault')) 118 end 104 119 end -
cprs/trunk/CPRS-Chart/Encounter/fPCEProvider.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORCtrls, ExtCtrls, uPCE, ORFn; 7 StdCtrls, ORCtrls, ExtCtrls, uPCE, ORFn, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmPCEProvider = class(T Form)11 TfrmPCEProvider = class(TfrmBase508Form) 11 12 cboPrimary: TORComboBox; 12 13 lblMsg: TMemo; -
cprs/trunk/CPRS-Chart/Encounter/fPatientEd.dfm
r456 r829 3 3 Top = 267 4 4 Caption = 'Patient Education' 5 ExplicitLeft = 275 6 ExplicitTop = 267 5 7 PixelsPerInch = 96 6 8 TextHeight = 13 … … 15 17 Width = 123 16 18 Caption = 'Patient Education Section' 19 ExplicitWidth = 123 17 20 end 18 21 inherited btnOK: TBitBtn … … 48 51 TabOrder = 3 49 52 end 53 object cboPatUnderstanding: TORComboBox [9] 54 Tag = 40 55 Left = 490 56 Top = 280 57 Width = 121 58 Height = 21 59 Style = orcsDropDown 60 AutoSelect = True 61 Caption = 'Level Of Understanding' 62 Color = clWindow 63 DropDownCount = 8 64 Enabled = False 65 ItemHeight = 13 66 ItemTipColor = clWindow 67 ItemTipEnable = True 68 ListItemsOnly = False 69 LongList = False 70 LookupPiece = 0 71 MaxLength = 0 72 Pieces = '2' 73 Sorted = False 74 SynonymChars = '<>' 75 TabOrder = 4 76 OnChange = cboPatUnderstandingChange 77 CharsNeedMatch = 1 78 end 50 79 inherited btnRemove: TButton 51 80 TabOrder = 5 … … 73 102 end 74 103 end 75 object cboPatUnderstanding: TORComboBox 76 Tag = 40 77 Left = 490 78 Top = 280 79 Width = 121 80 Height = 21 81 Style = orcsDropDown 82 AutoSelect = True 83 Caption = 'Level Of Understanding' 84 Color = clWindow 85 DropDownCount = 8 86 Enabled = False 87 ItemHeight = 13 88 ItemTipColor = clWindow 89 ItemTipEnable = True 90 ListItemsOnly = False 91 LongList = False 92 MaxLength = 0 93 Pieces = '2' 94 Sorted = False 95 SynonymChars = '<>' 96 TabOrder = 4 97 OnChange = cboPatUnderstandingChange 104 inherited amgrMain: TVA508AccessibilityManager 105 Data = ( 106 ( 107 'Component = cboPatUnderstanding' 108 'Status = stsDefault') 109 ( 110 'Component = edtComment' 111 'Label = lblComment' 112 'Status = stsOK') 113 ( 114 'Component = btnRemove' 115 'Status = stsDefault') 116 ( 117 'Component = btnSelectAll' 118 'Status = stsDefault') 119 ( 120 'Component = pnlMain' 121 'Status = stsDefault') 122 ( 123 'Component = lbxSection' 124 'Label = lblList' 125 'Status = stsOK') 126 ( 127 'Component = pnlLeft' 128 'Status = stsDefault') 129 ( 130 'Component = lbSection' 131 'Label = lblSection' 132 'Status = stsOK') 133 ( 134 'Component = btnOther' 135 'Status = stsDefault') 136 ( 137 'Component = pnlGrid' 138 'Status = stsDefault') 139 ( 140 'Component = lbGrid' 141 'Status = stsDefault') 142 ( 143 'Component = hcGrid' 144 'Status = stsDefault') 145 ( 146 'Component = btnOK' 147 'Status = stsDefault') 148 ( 149 'Component = btnCancel' 150 'Status = stsDefault') 151 ( 152 'Component = frmPatientEd' 153 'Status = stsDefault')) 98 154 end 99 155 end -
cprs/trunk/CPRS-Chart/Encounter/fPatientEd.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn, 8 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain ;8 fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager; 9 9 10 10 type … … 29 29 30 30 uses 31 fEncounterFrame ;31 fEncounterFrame, VA508AccessibilityRouter; 32 32 33 33 {/////////////////////////////////////////////////////////////////////////////// … … 121 121 end; 122 122 123 initialization 124 SpecifyFormIsNotADialog(TfrmPatientEd); 125 123 126 end. -
cprs/trunk/CPRS-Chart/Encounter/fProcedure.dfm
r456 r829 1 1 inherited frmProcedures: TfrmProcedures 2 Left = 2953 Top = 2122 Left = 548 3 Top = 172 4 4 Caption = 'Encounter Procedure' 5 ExplicitWidth = 632 6 ExplicitHeight = 427 5 7 PixelsPerInch = 96 6 8 TextHeight = 13 … … 15 17 Width = 88 16 18 Caption = 'Procedure Section' 19 ExplicitWidth = 88 17 20 end 18 21 inherited lblList: TLabel 19 22 Left = 154 23 ExplicitLeft = 154 20 24 end 21 25 inherited bvlMain: TBevel … … 23 27 Width = 537 24 28 Height = 166 29 ExplicitTop = 232 30 ExplicitWidth = 537 31 ExplicitHeight = 166 25 32 end 26 33 object lblMod: TLabel [5] … … 45 52 Top = 344 46 53 TabOrder = 8 54 ExplicitLeft = 544 55 ExplicitTop = 344 47 56 end 48 57 inherited btnCancel: TBitBtn 49 58 Top = 371 50 59 TabOrder = 9 60 ExplicitTop = 371 51 61 end 52 62 inherited pnlGrid: TPanel 53 63 Width = 523 54 64 TabOrder = 1 65 ExplicitWidth = 523 55 66 inherited lbGrid: TORListBox 56 67 Tag = 30 … … 58 69 Caption = 'Selected Procedures' 59 70 Pieces = '1,2' 71 ExplicitWidth = 523 60 72 end 61 73 inherited hcGrid: THeaderControl … … 74 86 Width = 112 75 87 end> 88 ExplicitWidth = 523 76 89 end 77 90 end … … 79 92 TabOrder = 2 80 93 end 81 inherited btnRemove: TButton 82 Left = 454 83 Top = 371 84 TabOrder = 7 85 end 86 inherited btnSelectAll: TButton 87 Left = 374 88 Top = 371 89 Height = 21 90 TabOrder = 6 91 TabStop = True 92 end 93 inherited pnlMain: TPanel 94 TabOrder = 0 95 inherited splLeft: TSplitter 96 Left = 145 97 end 98 object splRight: TSplitter [1] 99 Left = 349 100 Top = 0 101 Width = 3 102 Height = 204 103 Cursor = crHSplit 104 Align = alRight 105 OnMoved = splRightMoved 106 end 107 inherited lbxSection: TORListBox 108 Tag = 30 109 Left = 148 110 Width = 201 111 ItemHeight = 14 112 Pieces = '2,3' 113 end 114 inherited pnlLeft: TPanel 115 Width = 145 116 inherited lbSection: TORListBox 117 Tag = 30 118 Width = 145 119 TabOrder = 0 120 end 121 inherited btnOther: TButton 122 Tag = 13 123 Left = 3 124 Caption = 'Other Procedure...' 125 TabOrder = 1 126 end 127 end 128 object lbMods: TORListBox 129 Left = 352 130 Top = 0 131 Width = 260 132 Height = 204 133 Style = lbOwnerDrawFixed 134 Align = alRight 135 Font.Charset = DEFAULT_CHARSET 136 Font.Color = clWindowText 137 Font.Height = -11 138 Font.Name = 'MS Sans Serif' 139 Font.Style = [] 140 ItemHeight = 14 141 ParentFont = False 142 ParentShowHint = False 143 ShowHint = True 144 TabOrder = 2 145 Caption = 'Modifiers' 146 ItemTipColor = clWindow 147 LongList = False 148 Pieces = '2,3' 149 TabPosInPixels = True 150 CheckBoxes = True 151 CheckEntireLine = True 152 OnClickCheck = lbModsClickCheck 153 end 154 end 155 object spnProcQty: TUpDown 94 object spnProcQty: TUpDown [11] 156 95 Left = 348 157 96 Top = 371 … … 162 101 Position = 1 163 102 TabOrder = 5 164 Wrap = False 165 end 166 object txtProcQty: TCaptionEdit 103 end 104 object txtProcQty: TCaptionEdit [12] 167 105 Left = 288 168 106 Top = 371 … … 175 113 Caption = 'Quantity' 176 114 end 177 object cboProvider: TORComboBox 115 object cboProvider: TORComboBox [13] 178 116 Left = 56 179 117 Top = 371 … … 199 137 OnChange = cboProviderChange 200 138 OnNeedData = cboProviderNeedData 139 CharsNeedMatch = 1 140 end 141 inherited btnRemove: TButton 142 Left = 454 143 Top = 371 144 TabOrder = 7 145 ExplicitLeft = 454 146 ExplicitTop = 371 147 end 148 inherited btnSelectAll: TButton 149 Left = 374 150 Top = 371 151 Height = 21 152 TabOrder = 6 153 TabStop = True 154 ExplicitLeft = 374 155 ExplicitTop = 371 156 ExplicitHeight = 21 157 end 158 inherited pnlMain: TPanel 159 TabOrder = 0 160 inherited splLeft: TSplitter 161 Left = 145 162 ExplicitLeft = 145 163 end 164 object splRight: TSplitter [1] 165 Left = 349 166 Top = 0 167 Height = 204 168 Align = alRight 169 OnMoved = splRightMoved 170 end 171 inherited lbxSection: TORListBox 172 Tag = 30 173 Left = 148 174 Width = 201 175 ItemHeight = 14 176 Pieces = '2,3' 177 ExplicitLeft = 148 178 ExplicitWidth = 201 179 end 180 inherited pnlLeft: TPanel 181 Width = 145 182 ExplicitWidth = 145 183 inherited lbSection: TORListBox 184 Tag = 30 185 Width = 145 186 TabOrder = 0 187 ExplicitWidth = 145 188 end 189 inherited btnOther: TButton 190 Tag = 13 191 Left = 3 192 Caption = 'Other Procedure...' 193 TabOrder = 1 194 ExplicitLeft = 3 195 end 196 end 197 object lbMods: TORListBox 198 Left = 352 199 Top = 0 200 Width = 260 201 Height = 204 202 Style = lbOwnerDrawFixed 203 Align = alRight 204 Font.Charset = DEFAULT_CHARSET 205 Font.Color = clWindowText 206 Font.Height = -11 207 Font.Name = 'MS Sans Serif' 208 Font.Style = [] 209 ItemHeight = 14 210 ParentFont = False 211 ParentShowHint = False 212 ShowHint = True 213 TabOrder = 2 214 OnExit = lbModsExit 215 Caption = 'Modifiers' 216 ItemTipColor = clWindow 217 LongList = False 218 Pieces = '2,3' 219 TabPosInPixels = True 220 CheckBoxes = True 221 CheckEntireLine = True 222 OnClickCheck = lbModsClickCheck 223 end 224 end 225 inherited amgrMain: TVA508AccessibilityManager 226 Data = ( 227 ( 228 'Component = lbMods' 229 'Label = lblMod' 230 'Status = stsOK') 231 ( 232 'Component = spnProcQty' 233 'Status = stsDefault') 234 ( 235 'Component = txtProcQty' 236 'Status = stsDefault') 237 ( 238 'Component = cboProvider' 239 'Status = stsDefault') 240 ( 241 'Component = edtComment' 242 'Label = lblComment' 243 'Status = stsOK') 244 ( 245 'Component = btnRemove' 246 'Status = stsDefault') 247 ( 248 'Component = btnSelectAll' 249 'Status = stsDefault') 250 ( 251 'Component = pnlMain' 252 'Status = stsDefault') 253 ( 254 'Component = lbxSection' 255 'Label = lblList' 256 'Status = stsOK') 257 ( 258 'Component = pnlLeft' 259 'Status = stsDefault') 260 ( 261 'Component = lbSection' 262 'Label = lblSection' 263 'Status = stsOK') 264 ( 265 'Component = btnOther' 266 'Status = stsDefault') 267 ( 268 'Component = pnlGrid' 269 'Status = stsDefault') 270 ( 271 'Component = lbGrid' 272 'Status = stsDefault') 273 ( 274 'Component = hcGrid' 275 'Status = stsDefault') 276 ( 277 'Component = btnOK' 278 'Status = stsDefault') 279 ( 280 'Component = btnCancel' 281 'Status = stsDefault') 282 ( 283 'Component = frmProcedures' 284 'Status = stsDefault')) 201 285 end 202 286 end -
cprs/trunk/CPRS-Chart/Encounter/fProcedure.pas
r456 r829 1 1 unit fProcedure; 2 {Warning: The tab order has been changed in the OnExit event of several controls. 3 To change the tab order of lbSection, lbxSection, lbMods, and btnOther you must do it programatically.} 2 4 3 5 interface … … 6 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 9 fPCEBase, StdCtrls, ComCtrls, CheckLst, ORCtrls, ExtCtrls, Buttons, uPCE, rPCE, ORFn, 8 fPCELex, fPCEOther, fPCEBaseGrid, fPCEBaseMain ;10 fPCELex, fPCEOther, fPCEBaseGrid, fPCEBaseMain, VA508AccessibilityManager; 9 11 10 12 type … … 33 35 Direction, InsertAt: Integer); 34 36 procedure cboProviderChange(Sender: TObject); 37 procedure lbxSectionExit(Sender: TObject); 38 procedure lbModsExit(Sender: TObject); 39 procedure btnOtherExit(Sender: TObject); 35 40 private 36 41 FCheckingCode: boolean; … … 38 43 FLastCPTCodes: string; 39 44 FModsReadOnly: boolean; 45 FProviderChanging: boolean; 40 46 FModsROChecked: string; 41 47 function MissingProvider: boolean; … … 58 64 59 65 uses 60 fEncounterFrame, uConst, rCore ;66 fEncounterFrame, uConst, rCore, VA508AccessibilityRouter; 61 67 62 68 const … … 88 94 if(lbGrid.Selected[i]) then 89 95 TPCEProc(lbGrid.Items.Objects[i]).Provider := cboProvider.ItemIEN; 90 GridChanged; 96 FProviderChanging := TRUE; // CQ 11707 97 try 98 GridChanged; 99 finally 100 FProviderChanging := FALSE; 101 end; 91 102 end; 92 103 end; … … 102 113 FSectionTabCount := 1; 103 114 FormResize(Self); 115 lbMods.HideSelection := TRUE; 104 116 end; 105 117 … … 170 182 txtProcQty.Text := ''; 171 183 end; 172 if(SameProv) then 173 cboProvider.SetExactByIEN(Prov, ExternalName(Prov, 200)) 174 else 175 cboProvider.SetExactByIEN(uProviders.PCEProvider, uProviders.PCEProviderName); 176 //cboProvider.ItemIndex := -1; v22.8 - RV 184 if not FProviderChanging then // CQ 11707 185 begin 186 if(SameProv) then 187 cboProvider.SetExactByIEN(Prov, ExternalName(Prov, 200)) 188 else 189 cboProvider.SetExactByIEN(uProviders.PCEProvider, uProviders.PCEProviderName); 190 //cboProvider.ItemIndex := -1; v22.8 - RV 191 end; 177 192 end 178 193 else … … 418 433 end; 419 434 435 procedure TfrmProcedures.lbModsExit(Sender: TObject); 436 begin 437 inherited; 438 if TabIsPressed then 439 if btnOther.CanFocus then 440 btnOther.SetFocus; 441 end; 442 420 443 procedure TfrmProcedures.lbSectionClick(Sender: TObject); 421 444 begin … … 434 457 inherited; 435 458 Sync2Grid; 459 lbxSection.Selected[Index] := True; 436 460 if(lbxSection.ItemIndex >= 0) and (lbxSection.ItemIndex = Index) and 437 461 (lbxSection.Checked[Index]) then 438 462 begin 439 UpdateModifierList(lbxSection.Items, Index); 440 lbxSection.Checked[Index] := TRUE; 463 UpdateModifierList(lbxSection.Items, Index); // CQ#16439 464 lbxSection.Checked[Index] := TRUE; 441 465 for i := 0 to lbGrid.Items.Count-1 do 442 466 begin … … 456 480 Modifiers := Piece(lbxSection.Items[lbxSection.ItemIndex], U, 4); 457 481 GridChanged; 482 lbxSection.Selected[Index] := True; // CQ#15493 458 483 exit; 459 484 end; … … 466 491 end; 467 492 493 procedure TfrmProcedures.lbxSectionExit(Sender: TObject); 494 begin 495 if TabIsPressed then begin 496 if lbMods.CanFocus then 497 lbMods.SetFocus; 498 end 499 else if ShiftTabIsPressed then 500 if lbSection.CanFocus then 501 lbSection.SetFocus; 502 end; 503 468 504 procedure TfrmProcedures.btnOtherClick(Sender: TObject); 469 505 begin … … 471 507 Sync2Grid; 472 508 ShowModifiers; 509 end; 510 511 procedure TfrmProcedures.btnOtherExit(Sender: TObject); 512 begin 513 if TabIsPressed then begin 514 if lbGrid.CanFocus then 515 lbGrid.SetFocus; 516 end 517 else if ShiftTabIsPressed then 518 if lbMods.CanFocus then 519 lbMods.SetFocus; 473 520 end; 474 521 … … 537 584 end; 538 585 586 initialization 587 SpecifyFormIsNotADialog(TfrmProcedures); 588 539 589 end. -
cprs/trunk/CPRS-Chart/Encounter/fSkinTest.dfm
r456 r829 3 3 Top = 163 4 4 Caption = 'Encounter Skin Test form' 5 ExplicitLeft = 213 6 ExplicitTop = 163 5 7 PixelsPerInch = 96 6 8 TextHeight = 13 … … 38 40 Width = 84 39 41 Caption = 'Skin Test Section' 42 ExplicitWidth = 84 40 43 end 41 44 inherited btnOK: TBitBtn … … 76 79 TabOrder = 3 77 80 end 81 object UpDnReading: TUpDown [12] 82 Left = 531 83 Top = 304 84 Width = 15 85 Height = 21 86 Associate = EdtReading 87 Max = 40 88 TabOrder = 6 89 OnChanging = UpDnReadingChanging 90 end 91 object EdtReading: TCaptionEdit [13] 92 Left = 490 93 Top = 304 94 Width = 41 95 Height = 21 96 Enabled = False 97 TabOrder = 5 98 Text = '0' 99 OnChange = EdtReadingChange 100 Caption = 'Reading' 101 end 102 object edtDtRead: TCaptionEdit [14] 103 Left = 104 104 Top = 376 105 Width = 97 106 Height = 21 107 TabOrder = 8 108 Text = 'edtDtRead' 109 Visible = False 110 Caption = 'Date Read' 111 end 112 object edtDTGiven: TCaptionEdit [15] 113 Left = 280 114 Top = 376 115 Width = 81 116 Height = 21 117 TabOrder = 9 118 Text = 'edtDTGiven' 119 Visible = False 120 Caption = 'Date Given' 121 end 122 object cboSkinResults: TORComboBox [16] 123 Tag = 30 124 Left = 490 125 Top = 260 126 Width = 121 127 Height = 21 128 Style = orcsDropDown 129 AutoSelect = True 130 Caption = 'Results' 131 Color = clWindow 132 DropDownCount = 8 133 Enabled = False 134 ItemHeight = 13 135 ItemTipColor = clWindow 136 ItemTipEnable = True 137 ListItemsOnly = False 138 LongList = False 139 LookupPiece = 0 140 MaxLength = 0 141 Pieces = '2' 142 Sorted = False 143 SynonymChars = '<>' 144 TabOrder = 4 145 OnChange = cboSkinResultsChange 146 CharsNeedMatch = 1 147 end 78 148 inherited btnRemove: TButton 79 149 TabOrder = 7 … … 101 171 end 102 172 end 103 object UpDnReading: TUpDown 104 Left = 531 105 Top = 304 106 Width = 15 107 Height = 21 108 Associate = EdtReading 109 Min = 0 110 Max = 40 111 Position = 0 112 TabOrder = 6 113 Wrap = False 114 OnChanging = UpDnReadingChanging 115 end 116 object EdtReading: TCaptionEdit 117 Left = 490 118 Top = 304 119 Width = 41 120 Height = 21 121 Enabled = False 122 TabOrder = 5 123 Text = '0' 124 OnChange = EdtReadingChange 125 Caption = 'Reading' 126 end 127 object edtDtRead: TCaptionEdit 128 Left = 104 129 Top = 376 130 Width = 97 131 Height = 21 132 TabOrder = 8 133 Text = 'edtDtRead' 134 Visible = False 135 Caption = 'Date Read' 136 end 137 object edtDTGiven: TCaptionEdit 138 Left = 280 139 Top = 376 140 Width = 81 141 Height = 21 142 TabOrder = 9 143 Text = 'edtDTGiven' 144 Visible = False 145 Caption = 'Date Given' 146 end 147 object cboSkinResults: TORComboBox 148 Tag = 30 149 Left = 490 150 Top = 260 151 Width = 121 152 Height = 21 153 Style = orcsDropDown 154 AutoSelect = True 155 Caption = 'Results' 156 Color = clWindow 157 DropDownCount = 8 158 Enabled = False 159 ItemHeight = 13 160 ItemTipColor = clWindow 161 ItemTipEnable = True 162 ListItemsOnly = False 163 LongList = False 164 MaxLength = 0 165 Pieces = '2' 166 Sorted = False 167 SynonymChars = '<>' 168 TabOrder = 4 169 OnChange = cboSkinResultsChange 173 inherited amgrMain: TVA508AccessibilityManager 174 Data = ( 175 ( 176 'Component = UpDnReading' 177 'Status = stsDefault') 178 ( 179 'Component = EdtReading' 180 'Label = lblReading' 181 'Status = stsOK') 182 ( 183 'Component = edtDtRead' 184 'Label = lblDTRead' 185 'Status = stsOK') 186 ( 187 'Component = edtDTGiven' 188 'Label = lblDTGiven' 189 'Status = stsOK') 190 ( 191 'Component = cboSkinResults' 192 'Label = lblSkinResults' 193 'Status = stsOK') 194 ( 195 'Component = edtComment' 196 'Label = lblComment' 197 'Status = stsOK') 198 ( 199 'Component = btnRemove' 200 'Status = stsDefault') 201 ( 202 'Component = btnSelectAll' 203 'Status = stsDefault') 204 ( 205 'Component = pnlMain' 206 'Status = stsDefault') 207 ( 208 'Component = lbxSection' 209 'Label = lblList' 210 'Status = stsOK') 211 ( 212 'Component = pnlLeft' 213 'Status = stsDefault') 214 ( 215 'Component = lbSection' 216 'Label = lblSection' 217 'Status = stsOK') 218 ( 219 'Component = btnOther' 220 'Status = stsDefault') 221 ( 222 'Component = pnlGrid' 223 'Status = stsDefault') 224 ( 225 'Component = lbGrid' 226 'Status = stsDefault') 227 ( 228 'Component = hcGrid' 229 'Status = stsDefault') 230 ( 231 'Component = btnOK' 232 'Status = stsDefault') 233 ( 234 'Component = btnCancel' 235 'Status = stsDefault') 236 ( 237 'Component = frmSkinTests' 238 'Status = stsDefault')) 170 239 end 171 240 end -
cprs/trunk/CPRS-Chart/Encounter/fSkinTest.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, ORCtrls, StdCtrls, ComCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn, 8 fPCELex, fPCEOther, rCore, fPCEBaseMain ;8 fPCELex, fPCEOther, rCore, fPCEBaseMain, VA508AccessibilityManager; 9 9 10 10 type … … 41 41 42 42 uses 43 fEncounterFrame ;43 fEncounterFrame, VA508AccessibilityRouter; 44 44 45 45 procedure TfrmSkinTests.cboSkinResultsChange(Sender: TObject); … … 137 137 else 138 138 begin 139 Show message('If the reading is over 9, the results are required to be positive.');139 Show508Message('If the reading is over 9, the results are required to be positive.'); 140 140 cboSkinResults.SelectById('P'); 141 141 end; … … 245 245 end; 246 246 247 initialization 248 SpecifyFormIsNotADialog(TfrmSkinTests); 249 247 250 end. 248 251 -
cprs/trunk/CPRS-Chart/Encounter/fVisitType.dfm
r456 r829 1 1 inherited frmVisitType: TfrmVisitType 2 Left = 255 3 Top = 186 2 Left = 260 4 3 Caption = 'Encounter VisitType' 5 ClientWidth = 620 4 ClientHeight = 438 5 ClientWidth = 592 6 Constraints.MinHeight = 465 7 Constraints.MinWidth = 600 6 8 OnCloseQuery = FormCloseQuery 7 OnResize = FormResize 9 ExplicitLeft = 260 10 ExplicitWidth = 600 11 ExplicitHeight = 472 8 12 PixelsPerInch = 96 9 13 TextHeight = 13 10 object lblVType: TLabel [0]11 Left = 15012 Top = 613 Width = 6714 Height = 1315 Caption = 'Section Name'14 inherited btnOK: TBitBtn 15 Left = 436 16 Top = 414 17 TabOrder = 3 18 ExplicitLeft = 474 19 ExplicitTop = 459 16 20 end 17 object lblSCDisplay: TLabel [1] 18 Left = 6 19 Top = 123 20 Width = 186 21 Height = 13 22 Caption = 'Service Connection && Rated Disabilities' 23 end 24 object lblVTypeSection: TLabel [2] 25 Left = 6 26 Top = 6 27 Width = 58 28 Height = 13 29 Caption = 'Type of Visit' 30 end 31 object lblCurrentProv: TLabel [3] 32 Left = 277 33 Top = 249 34 Width = 165 35 Height = 13 36 Caption = 'Current providers for this encounter' 37 end 38 object lblProvider: TLabel [4] 39 Left = 6 40 Top = 249 41 Width = 89 42 Height = 13 43 Caption = 'Available providers' 44 end 45 object lblMod: TLabel [5] 46 Left = 358 47 Top = 6 48 Width = 42 49 Height = 13 50 Hint = 'Modifiers' 51 Caption = 'Modifiers' 52 ParentShowHint = False 53 ShowHint = True 54 end 55 inherited btnOK: TBitBtn 56 Left = 463 57 Top = 377 58 TabOrder = 8 59 end 60 inherited btnCancel: TBitBtn 61 Left = 543 62 Top = 377 63 TabOrder = 9 64 end 65 object pnlMain: TPanel 66 Left = 2 67 Top = 19 68 Width = 615 69 Height = 92 21 object pnlTop: TPanel [1] 22 Left = 0 23 Top = 0 24 Width = 592 25 Height = 105 26 Align = alTop 70 27 BevelOuter = bvNone 71 28 TabOrder = 0 29 ExplicitWidth = 630 72 30 object splLeft: TSplitter 73 31 Left = 145 74 32 Top = 0 75 Width = 376 Height = 9277 Cursor = crHSplit78 OnMoved = splLeftMoved33 Height = 105 34 ExplicitLeft = 154 35 ExplicitTop = 7 36 ExplicitHeight = 145 79 37 end 80 38 object splRight: TSplitter 81 Left = 352 82 Top = 0 83 Width = 3 84 Height = 92 85 Cursor = crHSplit 86 Align = alRight 87 OnMoved = splRightMoved 39 Left = 361 40 Top = 0 41 Height = 105 42 ExplicitLeft = 634 88 43 end 89 44 object pnlLeft: TPanel … … 91 46 Top = 0 92 47 Width = 145 93 Height = 9248 Height = 105 94 49 Align = alLeft 95 50 BevelOuter = bvNone 96 51 TabOrder = 0 52 ExplicitHeight = 145 53 object lblVTypeSection: TLabel 54 Left = 0 55 Top = 0 56 Width = 145 57 Height = 13 58 Align = alTop 59 Caption = 'Type of Visit' 60 ExplicitWidth = 58 61 end 97 62 object lstVTypeSection: TORListBox 98 63 Tag = 10 99 64 Left = 0 100 Top = 065 Top = 13 101 66 Width = 145 102 67 Height = 92 103 Align = al Top68 Align = alClient 104 69 ItemHeight = 13 105 70 ParentShowHint = False … … 114 79 end 115 80 end 116 object lbxVisits: TORListBox 117 Tag = 10 81 object pnlModifiers: TPanel 82 Left = 364 83 Top = 0 84 Width = 228 85 Height = 105 86 Align = alClient 87 BevelOuter = bvNone 88 TabOrder = 2 89 ExplicitLeft = 431 90 ExplicitWidth = 199 91 ExplicitHeight = 145 92 object lblMod: TLabel 93 Left = 0 94 Top = 0 95 Width = 228 96 Height = 13 97 Hint = 'Modifiers' 98 Align = alTop 99 Caption = 'Modifiers' 100 ParentShowHint = False 101 ShowHint = True 102 ExplicitWidth = 42 103 end 104 object lbMods: TORListBox 105 Left = 0 106 Top = 13 107 Width = 228 108 Height = 92 109 Style = lbOwnerDrawFixed 110 Align = alClient 111 Font.Charset = DEFAULT_CHARSET 112 Font.Color = clWindowText 113 Font.Height = -11 114 Font.Name = 'MS Sans Serif' 115 Font.Style = [] 116 ItemHeight = 14 117 ParentFont = False 118 ParentShowHint = False 119 ShowHint = True 120 TabOrder = 0 121 Caption = 'Modifiers' 122 ItemTipColor = clWindow 123 LongList = False 124 Pieces = '2,3' 125 TabPosInPixels = True 126 CheckBoxes = True 127 CheckEntireLine = True 128 OnClickCheck = lbModsClickCheck 129 ExplicitWidth = 199 130 ExplicitHeight = 132 131 end 132 end 133 object pnlSection: TPanel 118 134 Left = 148 119 135 Top = 0 120 Width = 204 121 Height = 92 122 Style = lbOwnerDrawFixed 136 Width = 213 137 Height = 105 138 Align = alLeft 139 BevelOuter = bvNone 140 Caption = 'pnlSection' 141 TabOrder = 1 142 object lblVType: TLabel 143 Left = 0 144 Top = 0 145 Width = 213 146 Height = 13 147 Align = alTop 148 Caption = 'Section Name' 149 ExplicitWidth = 67 150 end 151 object lbxVisits: TORListBox 152 Tag = 10 153 Left = 0 154 Top = 13 155 Width = 213 156 Height = 92 157 Style = lbOwnerDrawFixed 158 Align = alClient 159 ItemHeight = 16 160 ParentShowHint = False 161 ShowHint = True 162 TabOrder = 0 163 OnClick = lbxVisitsClick 164 Caption = 'Section Name' 165 ItemTipColor = clWindow 166 LongList = False 167 Pieces = '3,4,5' 168 TabPosInPixels = True 169 CheckBoxes = True 170 CheckEntireLine = True 171 OnClickCheck = lbxVisitsClickCheck 172 ExplicitLeft = -3 173 ExplicitTop = 7 174 ExplicitWidth = 281 175 end 176 end 177 end 178 object pnlMiddle: TPanel [2] 179 Left = 0 180 Top = 105 181 Width = 592 182 Height = 164 183 Align = alTop 184 BevelOuter = bvNone 185 TabOrder = 1 186 ExplicitTop = 145 187 ExplicitWidth = 630 188 inline fraVisitRelated: TfraVisitRelated 189 Left = 384 190 Top = 0 191 Width = 208 192 Height = 164 193 Align = alRight 194 TabOrder = 1 195 ExplicitLeft = 384 196 ExplicitWidth = 208 197 ExplicitHeight = 164 198 inherited gbVisitRelatedTo: TGroupBox 199 Width = 208 200 Height = 164 201 ExplicitWidth = 208 202 ExplicitHeight = 164 203 inherited chkMSTYes: TCheckBox 204 Top = 127 205 ExplicitTop = 127 206 end 207 inherited chkMSTNo: TCheckBox 208 Top = 127 209 ExplicitTop = 127 210 end 211 inherited chkHNCYes: TCheckBox 212 Top = 143 213 ExplicitTop = 143 214 end 215 inherited chkHNCNo: TCheckBox 216 Top = 142 217 Width = 150 218 Height = 18 219 Caption = 'Head and/or Neck Cancer No' 220 ExplicitTop = 142 221 ExplicitWidth = 150 222 ExplicitHeight = 18 223 end 224 end 225 end 226 object pnlSC: TPanel 227 Left = 0 228 Top = 0 229 Width = 384 230 Height = 164 123 231 Align = alClient 124 ItemHeight = 16 125 ParentShowHint = False 126 ShowHint = True 232 BevelOuter = bvNone 233 TabOrder = 0 234 ExplicitWidth = 422 235 object lblSCDisplay: TLabel 236 Left = 0 237 Top = 0 238 Width = 384 239 Height = 13 240 Align = alTop 241 Caption = 'Service Connection && Rated Disabilities' 242 ExplicitWidth = 186 243 end 244 object memSCDisplay: TCaptionMemo 245 Left = 0 246 Top = 13 247 Width = 384 248 Height = 151 249 Align = alClient 250 Color = clBtnFace 251 Lines.Strings = ( 252 '') 253 ReadOnly = True 254 ScrollBars = ssVertical 255 TabOrder = 0 256 OnEnter = memSCDisplayEnter 257 Caption = 'Service Connection && Rated Disabilities' 258 end 259 end 260 end 261 object pnlBottom: TPanel [3] 262 Left = 0 263 Top = 269 264 Width = 592 265 Height = 141 266 Align = alTop 267 BevelOuter = bvNone 268 TabOrder = 2 269 ExplicitTop = 309 270 ExplicitWidth = 630 271 object btnAdd: TButton 272 Left = 260 273 Top = 35 274 Width = 75 275 Height = 21 276 Caption = 'Add' 127 277 TabOrder = 1 128 OnClick = lbxVisitsClick 129 Caption = 'Section Name' 130 ItemTipColor = clWindow 131 LongList = False 132 Pieces = '3,4,5' 133 TabPosInPixels = True 134 CheckBoxes = True 135 CheckEntireLine = True 136 OnClickCheck = lbxVisitsClickCheck 137 end 138 object lbMods: TORListBox 139 Left = 355 140 Top = 0 141 Width = 260 142 Height = 92 143 Style = lbOwnerDrawFixed 278 OnClick = btnAddClick 279 end 280 object btnDelete: TButton 281 Left = 260 282 Top = 72 283 Width = 75 284 Height = 21 285 Caption = 'Remove' 286 TabOrder = 2 287 OnClick = btnDeleteClick 288 end 289 object btnPrimary: TButton 290 Left = 260 291 Top = 112 292 Width = 75 293 Height = 21 294 Caption = 'Primary' 295 TabOrder = 3 296 OnClick = btnPrimaryClick 297 end 298 object pnlBottomLeft: TPanel 299 Left = 0 300 Top = 0 301 Width = 240 302 Height = 141 303 Align = alLeft 304 BevelOuter = bvNone 305 TabOrder = 0 306 object lblProvider: TLabel 307 Left = 0 308 Top = 0 309 Width = 240 310 Height = 13 311 Align = alTop 312 Caption = 'Available providers' 313 ExplicitWidth = 89 314 end 315 object cboPtProvider: TORComboBox 316 Left = 0 317 Top = 13 318 Width = 240 319 Height = 128 320 Style = orcsSimple 321 Align = alClient 322 AutoSelect = True 323 Caption = 'Available providers' 324 Color = clWindow 325 DropDownCount = 8 326 ItemHeight = 13 327 ItemTipColor = clWindow 328 ItemTipEnable = True 329 ListItemsOnly = True 330 LongList = True 331 LookupPiece = 2 332 MaxLength = 0 333 Pieces = '2,3' 334 Sorted = False 335 SynonymChars = '<>' 336 TabOrder = 0 337 CheckEntireLine = True 338 OnChange = cboPtProviderChange 339 OnDblClick = cboPtProviderDblClick 340 OnNeedData = cboPtProviderNeedData 341 CharsNeedMatch = 1 342 ExplicitWidth = 260 343 end 344 end 345 object pnlBottomRight: TPanel 346 Left = 352 347 Top = 0 348 Width = 240 349 Height = 141 144 350 Align = alRight 145 Font.Charset = DEFAULT_CHARSET 146 Font.Color = clWindowText 147 Font.Height = -11 148 Font.Name = 'MS Sans Serif' 149 Font.Style = [] 150 ItemHeight = 14 151 ParentFont = False 152 ParentShowHint = False 153 ShowHint = True 154 TabOrder = 2 155 Caption = 'Modifiers' 156 ItemTipColor = clWindow 157 LongList = False 158 Pieces = '2,3' 159 TabPosInPixels = True 160 CheckBoxes = True 161 CheckEntireLine = True 162 OnClickCheck = lbModsClickCheck 351 BevelOuter = bvNone 352 TabOrder = 4 353 object lblCurrentProv: TLabel 354 Left = 0 355 Top = 0 356 Width = 240 357 Height = 13 358 Align = alTop 359 Caption = 'Current providers for this encounter' 360 ExplicitWidth = 165 361 end 362 object lbProviders: TORListBox 363 Left = 0 364 Top = 13 365 Width = 240 366 Height = 128 367 Align = alClient 368 ItemHeight = 13 369 ParentShowHint = False 370 ShowHint = True 371 TabOrder = 0 372 OnDblClick = lbProvidersDblClick 373 Caption = 'Current providers for this encounter' 374 ItemTipColor = clWindow 375 LongList = False 376 Pieces = '2' 377 OnChange = lbProvidersChange 378 CheckEntireLine = True 379 ExplicitTop = 11 380 ExplicitWidth = 220 381 end 163 382 end 164 383 end 165 object memSCDisplay: TCaptionMemo 166 Left = 6 167 Top = 137 168 Width = 411 169 Height = 107 170 Color = clBtnFace 171 Lines.Strings = ( 172 '') 173 ScrollBars = ssVertical 174 TabOrder = 1 175 Caption = 'Service Connection && Rated Disabilities' 384 inherited btnCancel: TBitBtn 385 Left = 517 386 Top = 414 387 TabOrder = 4 388 ExplicitLeft = 555 389 ExplicitTop = 459 176 390 end 177 object lbProviders: TORListBox 178 Left = 277 179 Top = 265 180 Width = 183 181 Height = 126 182 ItemHeight = 13 183 ParentShowHint = False 184 ShowHint = True 185 TabOrder = 7 186 OnDblClick = lbProvidersDblClick 187 Caption = 'Current providers for this encounter' 188 ItemTipColor = clWindow 189 LongList = False 190 Pieces = '2' 191 OnChange = lbProvidersChange 192 CheckEntireLine = True 193 end 194 object cboPtProvider: TORComboBox 195 Left = 6 196 Top = 265 197 Width = 183 198 Height = 126 199 Style = orcsSimple 200 AutoSelect = True 201 Caption = 'Available providers' 202 Color = clWindow 203 DropDownCount = 8 204 ItemHeight = 13 205 ItemTipColor = clWindow 206 ItemTipEnable = True 207 ListItemsOnly = True 208 LongList = True 209 LookupPiece = 2 210 MaxLength = 0 211 Pieces = '2,3' 212 Sorted = False 213 SynonymChars = '<>' 214 TabOrder = 3 215 TabStop = True 216 CheckEntireLine = True 217 OnChange = cboPtProviderChange 218 OnDblClick = cboPtProviderDblClick 219 OnNeedData = cboPtProviderNeedData 220 end 221 object btnAdd: TButton 222 Left = 196 223 Top = 275 224 Width = 75 225 Height = 21 226 Caption = 'Add' 227 TabOrder = 4 228 OnClick = btnAddClick 229 end 230 object btnDelete: TButton 231 Left = 196 232 Top = 307 233 Width = 75 234 Height = 21 235 Caption = 'Remove' 236 TabOrder = 5 237 OnClick = btnDeleteClick 238 end 239 object btnPrimary: TButton 240 Left = 196 241 Top = 355 242 Width = 75 243 Height = 21 244 Caption = 'Primary' 245 TabOrder = 6 246 OnClick = btnPrimaryClick 247 end 248 inline fraVisitRelated: TfraVisitRelated 249 Left = 426 250 Top = 112 251 Width = 192 252 Height = 137 253 TabOrder = 2 391 inherited amgrMain: TVA508AccessibilityManager 392 Left = 8 393 Top = 24 394 Data = ( 395 ( 396 'Component = btnOK' 397 'Status = stsDefault') 398 ( 399 'Component = btnCancel' 400 'Status = stsDefault') 401 ( 402 'Component = frmVisitType' 403 'Status = stsDefault') 404 ( 405 'Component = pnlTop' 406 'Status = stsDefault') 407 ( 408 'Component = pnlLeft' 409 'Status = stsDefault') 410 ( 411 'Component = lstVTypeSection' 412 'Label = lblVTypeSection' 413 'Status = stsOK') 414 ( 415 'Component = pnlMiddle' 416 'Status = stsDefault') 417 ( 418 'Component = fraVisitRelated' 419 'Status = stsDefault') 420 ( 421 'Component = fraVisitRelated.gbVisitRelatedTo' 422 'Status = stsDefault') 423 ( 424 'Component = fraVisitRelated.chkSCYes' 425 'Status = stsDefault') 426 ( 427 'Component = fraVisitRelated.chkAOYes' 428 'Status = stsDefault') 429 ( 430 'Component = fraVisitRelated.chkIRYes' 431 'Status = stsDefault') 432 ( 433 'Component = fraVisitRelated.chkECYes' 434 'Status = stsDefault') 435 ( 436 'Component = fraVisitRelated.chkMSTYes' 437 'Status = stsDefault') 438 ( 439 'Component = fraVisitRelated.chkMSTNo' 440 'Status = stsDefault') 441 ( 442 'Component = fraVisitRelated.chkECNo' 443 'Status = stsDefault') 444 ( 445 'Component = fraVisitRelated.chkIRNo' 446 'Status = stsDefault') 447 ( 448 'Component = fraVisitRelated.chkAONo' 449 'Status = stsDefault') 450 ( 451 'Component = fraVisitRelated.chkSCNo' 452 'Status = stsDefault') 453 ( 454 'Component = fraVisitRelated.chkHNCYes' 455 'Status = stsDefault') 456 ( 457 'Component = fraVisitRelated.chkHNCNo' 458 'Status = stsDefault') 459 ( 460 'Component = fraVisitRelated.chkCVYes' 461 'Status = stsDefault') 462 ( 463 'Component = fraVisitRelated.chkCVNo' 464 'Status = stsDefault') 465 ( 466 'Component = fraVisitRelated.chkSHDYes' 467 'Status = stsDefault') 468 ( 469 'Component = fraVisitRelated.chkSHDNo' 470 'Status = stsDefault') 471 ( 472 'Component = fraVisitRelated.lblSCNo' 473 'Status = stsDefault') 474 ( 475 'Component = fraVisitRelated.lblSCYes' 476 'Status = stsDefault') 477 ( 478 'Component = pnlSC' 479 'Status = stsDefault') 480 ( 481 'Component = memSCDisplay' 482 'Label = lblSCDisplay' 483 'Status = stsOK') 484 ( 485 'Component = pnlBottom' 486 'Status = stsDefault') 487 ( 488 'Component = btnAdd' 489 'Status = stsDefault') 490 ( 491 'Component = btnDelete' 492 'Status = stsDefault') 493 ( 494 'Component = btnPrimary' 495 'Status = stsDefault') 496 ( 497 'Component = pnlBottomLeft' 498 'Status = stsDefault') 499 ( 500 'Component = cboPtProvider' 501 'Label = lblProvider' 502 'Status = stsOK') 503 ( 504 'Component = pnlBottomRight' 505 'Status = stsDefault') 506 ( 507 'Component = lbProviders' 508 'Label = lblCurrentProv' 509 'Status = stsOK') 510 ( 511 'Component = pnlModifiers' 512 'Status = stsDefault') 513 ( 514 'Component = lbMods' 515 'Label = lblMod' 516 'Status = stsOK') 517 ( 518 'Component = pnlSection' 519 'Status = stsDefault') 520 ( 521 'Component = lbxVisits' 522 'Label = lblVType' 523 'Status = stsOK')) 254 524 end 255 525 end -
cprs/trunk/CPRS-Chart/Encounter/fVisitType.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fPCEBase, StdCtrls, CheckLst, ORCtrls, ExtCtrls, Buttons, uPCE, rPCE, ORFn, rCore, 8 ComCtrls, mVisitRelated ;8 ComCtrls, mVisitRelated, VA508AccessibilityManager; 9 9 10 10 type 11 11 TfrmVisitType = class(TfrmPCEBase) 12 lblVType: TLabel; 12 pnlTop: TPanel; 13 splLeft: TSplitter; 14 splRight: TSplitter; 15 pnlLeft: TPanel; 16 lstVTypeSection: TORListBox; 17 pnlMiddle: TPanel; 18 fraVisitRelated: TfraVisitRelated; 19 pnlSC: TPanel; 13 20 lblSCDisplay: TLabel; 14 lblVTypeSection: TLabel;15 21 memSCDisplay: TCaptionMemo; 16 lbProviders: TORListBox; 17 lblCurrentProv: TLabel; 18 cboPtProvider: TORComboBox; 19 lblProvider: TLabel; 22 pnlBottom: TPanel; 20 23 btnAdd: TButton; 21 24 btnDelete: TButton; 22 25 btnPrimary: TButton; 23 fraVisitRelated: TfraVisitRelated; 24 lstVTypeSection: TORListBox; 25 lbxVisits: TORListBox; 26 pnlBottomLeft: TPanel; 27 lblProvider: TLabel; 28 cboPtProvider: TORComboBox; 29 pnlBottomRight: TPanel; 30 lbProviders: TORListBox; 31 lblCurrentProv: TLabel; 32 lblVTypeSection: TLabel; 33 pnlModifiers: TPanel; 26 34 lbMods: TORListBox; 27 35 lblMod: TLabel; 28 pnl Main: TPanel;29 pnlLeft: TPanel;30 splLeft: TSplitter;36 pnlSection: TPanel; 37 lbxVisits: TORListBox; 38 lblVType: TLabel; 31 39 procedure lstVTypeSectionClick(Sender: TObject); 32 40 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); … … 43 51 procedure FormResize(Sender: TObject); 44 52 procedure lbxVisitsClickCheck(Sender: TObject; Index: Integer); 45 procedure splLeftMoved(Sender: TObject);46 procedure splRightMoved(Sender: TObject);47 53 procedure lbModsClickCheck(Sender: TObject; Index: Integer); 48 54 procedure lbxVisitsClick(Sender: TObject); 55 procedure memSCDisplayEnter(Sender: TObject); 49 56 protected 50 57 FSplitterMove: boolean; … … 76 83 77 84 uses 78 fEncounterFrame, uCore, uConst ;85 fEncounterFrame, uCore, uConst, VA508AccessibilityRouter; 79 86 80 87 const … … 198 205 RefreshProviders; 199 206 FLastMods := uEncPCEData.VisitType.Modifiers; 207 fraVisitRelated.TabStop := FALSE; 200 208 end; 201 209 … … 325 333 v, i: integer; 326 334 s: string; 335 padding, size: integer; 336 btnOffset: integer; 327 337 begin 328 338 if FSplitterMove then 329 339 FSplitterMove := FALSE 330 340 else 331 begin 332 inherited; 333 FSectionTabs[0] := -(lbxVisits.width - LBCheckWidthSpace - MainFontWidth - ScrollBarWidth); 334 FSectionTabs[1] := -(lbxVisits.width - (6*MainFontWidth) - ScrollBarWidth); 335 if(FSectionTabs[0] <= FSectionTabs[1]) then FSectionTabs[0] := FSectionTabs[1]+2; 336 lbxVisits.TabPositions := SectionString; 337 v := (lbMods.width - LBCheckWidthSpace - (4*MainFontWidth) - ScrollBarWidth); 338 s := ''; 339 for i := 1 to 20 do 340 begin 341 if s <> '' then s := s + ','; 342 s := s + inttostr(v); 343 if(v<0) then 344 dec(v,32) 345 else 346 inc(v,32); 347 end; 348 lbMods.TabPositions := s; 349 end; 341 begin 342 // inherited; 343 FSectionTabs[0] := -(lbxVisits.width - LBCheckWidthSpace - MainFontWidth - ScrollBarWidth); 344 FSectionTabs[1] := -(lbxVisits.width - (6*MainFontWidth) - ScrollBarWidth); 345 if(FSectionTabs[0] <= FSectionTabs[1]) then FSectionTabs[0] := FSectionTabs[1]+2; 346 lbxVisits.TabPositions := SectionString; 347 v := (lbMods.width - LBCheckWidthSpace - (4*MainFontWidth) - ScrollBarWidth); 348 s := ''; 349 for i := 1 to 20 do 350 begin 351 if s <> '' then s := s + ','; 352 s := s + inttostr(v); 353 if(v<0) then 354 dec(v,32) 355 else 356 inc(v,32); 357 end; 358 lbMods.TabPositions := s; 359 end; 360 btnOffset := btnAdd.Width div 7; 361 padding := btnAdd.Width + (btnOffset * 2); 362 size := (ClientWidth - padding) div 2; 363 pnlBottomLeft.Width := size; 364 pnlBottomRight.Width := size; 365 btnAdd.Left := size + btnOffset; 366 btnDelete.Left := size + btnOffset; 367 btnPrimary.Left := size + btnOffset; 368 btnOK.top := ClientHeight - btnOK.Height - 4; 369 btnCancel.top := btnOK.Top; 370 btnCancel.Left := ClientWidth - btnCancel.Width - 4; 371 btnOK.Left := btnCancel.Left - btnOK.Width - 4; 372 size := ClientHeight - btnOK.Height - pnlMiddle.Height - pnlBottom.Height - 8; 373 pnlTop.Height := size; 350 374 end; 351 375 … … 479 503 end; 480 504 481 procedure TfrmVisitType.splLeftMoved(Sender: TObject);482 begin483 inherited;484 lblVType.Left := lbxVisits.Left + pnlMain.Left;485 FSplitterMove := TRUE;486 FormResize(Sender);487 end;488 489 procedure TfrmVisitType.splRightMoved(Sender: TObject);490 begin491 inherited;492 lblMod.Left := lbMods.Left + pnlMain.Left;493 FSplitterMove := TRUE;494 FormResize(Sender);495 end;496 497 505 procedure TfrmVisitType.lbModsClickCheck(Sender: TObject; Index: Integer); 498 506 var … … 527 535 end; 528 536 537 procedure TfrmVisitType.memSCDisplayEnter(Sender: TObject); 538 begin 539 inherited; 540 memSCDisplay.SelStart := 0; 541 end; 542 529 543 initialization 544 SpecifyFormIsNotADialog(TfrmVisitType); 545 530 546 //frmVisitType.CreateProviderList; 531 547 -
cprs/trunk/CPRS-Chart/Encounter/mVisitRelated.dfm
r456 r829 2 2 Left = 0 3 3 Top = 0 4 Width = 1925 Height = 1 364 Width = 206 5 Height = 172 6 6 TabOrder = 0 7 object bvlSCFrame: TBevel7 object gbVisitRelatedTo: TGroupBox 8 8 Left = 0 9 Top = 1410 Width = 19111 Height = 11912 Shape = bsFrame13 end14 object lblSCYes: TStaticText15 Left = 316 9 Top = 0 17 Width = 22 18 Height = 13 19 AutoSize = False 20 Caption = 'Yes' 21 TabOrder = 14 22 end 23 object lblSCNo: TStaticText 24 Left = 26 25 Top = 0 26 Width = 18 27 Height = 13 28 AutoSize = False 29 Caption = 'No' 30 TabOrder = 15 31 end 32 object lblSCSelect: TStaticText 33 Left = 44 34 Top = 0 35 Width = 131 36 Height = 13 37 Alignment = taCenter 38 AutoSize = False 10 Width = 206 11 Height = 172 12 Align = alClient 39 13 Caption = 'Visit Related To' 40 TabOrder = 1641 end42 object chkSCYes: TCheckBox43 Tag = 144 Left = 645 Top = 1746 Width = 1647 Height = 1748 14 TabOrder = 0 49 OnClick = chkClick 50 end 51 object chkAOYes: TCheckBox 52 Tag = 2 53 Left = 6 54 Top = 49 55 Width = 16 56 Height = 17 57 TabOrder = 4 58 OnClick = chkClick 59 end 60 object chkIRYes: TCheckBox 61 Tag = 3 62 Left = 6 63 Top = 65 64 Width = 16 65 Height = 17 66 TabOrder = 6 67 OnClick = chkClick 68 end 69 object chkECYes: TCheckBox 70 Tag = 4 71 Left = 6 72 Top = 81 73 Width = 16 74 Height = 17 75 TabOrder = 8 76 OnClick = chkClick 77 end 78 object chkMSTYes: TCheckBox 79 Tag = 5 80 Left = 6 81 Top = 97 82 Width = 16 83 Height = 17 84 TabOrder = 10 85 OnClick = chkClick 86 end 87 object chkMSTNo: TCheckBox 88 Tag = 15 89 Left = 26 90 Top = 97 91 Width = 160 92 Height = 17 93 Caption = 'MST' 94 TabOrder = 11 95 OnClick = chkClick 96 end 97 object chkECNo: TCheckBox 98 Tag = 14 99 Left = 26 100 Top = 81 101 Width = 160 102 Height = 17 103 Caption = 'Environmental Contaminants' 104 TabOrder = 9 105 OnClick = chkClick 106 end 107 object chkIRNo: TCheckBox 108 Tag = 13 109 Left = 26 110 Top = 65 111 Width = 160 112 Height = 17 113 Caption = 'Ionizing Radiation Exposure' 114 TabOrder = 7 115 OnClick = chkClick 116 end 117 object chkAONo: TCheckBox 118 Tag = 12 119 Left = 26 120 Top = 49 121 Width = 160 122 Height = 17 123 Caption = 'Agent Orange Exposure' 124 TabOrder = 5 125 OnClick = chkClick 126 end 127 object chkSCNo: TCheckBox 128 Tag = 11 129 Left = 26 130 Top = 17 131 Width = 160 132 Height = 17 133 Caption = 'Service Connected Condition' 134 TabOrder = 1 135 OnClick = chkClick 136 end 137 object chkHNCYes: TCheckBox 138 Tag = 6 139 Left = 6 140 Top = 113 141 Width = 16 142 Height = 17 143 TabOrder = 12 144 OnClick = chkClick 145 end 146 object chkHNCNo: TCheckBox 147 Tag = 16 148 Left = 26 149 Top = 113 150 Width = 160 151 Height = 17 152 Caption = 'Head and/or Neck Cancer' 153 TabOrder = 13 154 OnClick = chkClick 155 end 156 object chkCVYes: TCheckBox 157 Tag = 7 158 Left = 6 159 Top = 33 160 Width = 16 161 Height = 17 162 TabOrder = 2 163 OnClick = chkClick 164 end 165 object chkCVNo: TCheckBox 166 Tag = 17 167 Left = 26 168 Top = 33 169 Width = 160 170 Height = 17 171 Caption = 'Combat Vet (Combat Related)' 172 TabOrder = 3 173 OnClick = chkClick 15 object chkSCYes: TCheckBox 16 Tag = 1 17 Left = 7 18 Top = 33 19 Width = 14 20 Height = 17 21 Caption = 'Service Connected Condition Yes' 22 TabOrder = 0 23 OnClick = chkClick 24 end 25 object chkAOYes: TCheckBox 26 Tag = 2 27 Left = 7 28 Top = 65 29 Width = 14 30 Height = 17 31 Caption = 'Agent Orange Exposure Yes' 32 TabOrder = 4 33 OnClick = chkClick 34 end 35 object chkIRYes: TCheckBox 36 Tag = 3 37 Left = 7 38 Top = 81 39 Width = 14 40 Height = 17 41 Caption = 'Ionizing Radiation Exposure Yes' 42 TabOrder = 6 43 OnClick = chkClick 44 end 45 object chkECYes: TCheckBox 46 Tag = 4 47 Left = 7 48 Top = 97 49 Width = 14 50 Height = 17 51 Caption = 'Southwest Asia Conditions Yes' 52 TabOrder = 8 53 OnClick = chkClick 54 end 55 object chkMSTYes: TCheckBox 56 Tag = 5 57 Left = 7 58 Top = 129 59 Width = 14 60 Height = 17 61 Caption = 'MST Yes' 62 TabOrder = 12 63 OnClick = chkClick 64 end 65 object chkMSTNo: TCheckBox 66 Tag = 15 67 Left = 27 68 Top = 129 69 Width = 40 70 Height = 17 71 Caption = 'MST No' 72 TabOrder = 13 73 OnClick = chkClick 74 end 75 object chkECNo: TCheckBox 76 Tag = 14 77 Left = 27 78 Top = 97 79 Width = 148 80 Height = 17 81 Caption = 'Southwest Asia Conditions No' 82 TabOrder = 9 83 OnClick = chkClick 84 end 85 object chkIRNo: TCheckBox 86 Tag = 13 87 Left = 27 88 Top = 81 89 Width = 154 90 Height = 17 91 Caption = 'Ionizing Radiation Exposure No' 92 TabOrder = 7 93 OnClick = chkClick 94 end 95 object chkAONo: TCheckBox 96 Tag = 12 97 Left = 27 98 Top = 65 99 Width = 136 100 Height = 17 101 Caption = 'Agent Orange Exposure No' 102 TabOrder = 5 103 OnClick = chkClick 104 end 105 object chkSCNo: TCheckBox 106 Tag = 11 107 Left = 27 108 Top = 33 109 Width = 158 110 Height = 17 111 Caption = 'Service Connected Condition No' 112 TabOrder = 1 113 OnClick = chkClick 114 end 115 object chkHNCYes: TCheckBox 116 Tag = 6 117 Left = 7 118 Top = 145 119 Width = 14 120 Height = 17 121 Caption = 'Head and/or Neck Cancer Yes' 122 TabOrder = 14 123 OnClick = chkClick 124 end 125 object chkHNCNo: TCheckBox 126 Tag = 16 127 Left = 27 128 Top = 145 129 Width = 144 130 Height = 17 131 Caption = 'Head and/or Neck Cancer No' 132 TabOrder = 15 133 OnClick = chkClick 134 end 135 object chkCVYes: TCheckBox 136 Tag = 7 137 Left = 7 138 Top = 49 139 Width = 14 140 Height = 17 141 Caption = 'Combat Vet (Combat Related) Yes' 142 TabOrder = 2 143 OnClick = chkClick 144 end 145 object chkCVNo: TCheckBox 146 Tag = 17 147 Left = 27 148 Top = 49 149 Width = 165 150 Height = 17 151 Caption = 'Combat Vet (Combat Related) No' 152 TabOrder = 3 153 OnClick = chkClick 154 end 155 object chkSHDYes: TCheckBox 156 Tag = 8 157 Left = 7 158 Top = 112 159 Width = 14 160 Height = 17 161 Caption = 'Shipboard Hazard and Defense Yes' 162 TabOrder = 10 163 OnClick = chkClick 164 end 165 object chkSHDNo: TCheckBox 166 Tag = 18 167 Left = 27 168 Top = 112 169 Width = 168 170 Height = 17 171 Caption = 'Shipboard Hazard and Defense No' 172 TabOrder = 11 173 OnClick = chkClick 174 end 175 object lblSCNo: TStaticText 176 Left = 27 177 Top = 16 178 Width = 18 179 Height = 13 180 AutoSize = False 181 Caption = 'No' 182 TabOrder = 17 183 end 184 object lblSCYes: TStaticText 185 Left = 4 186 Top = 16 187 Width = 22 188 Height = 13 189 AutoSize = False 190 Caption = 'Yes' 191 TabOrder = 16 192 end 174 193 end 175 194 end -
cprs/trunk/CPRS-Chart/Encounter/mVisitRelated.pas
r456 r829 9 9 type 10 10 TfraVisitRelated = class(TFrame) 11 lblSCYes: TStaticText; 12 lblSCNo: TStaticText; 13 lblSCSelect: TStaticText; 14 bvlSCFrame: TBevel; 11 gbVisitRelatedTo: TGroupBox; 15 12 chkSCYes: TCheckBox; 16 13 chkAOYes: TCheckBox; … … 27 24 chkCVYes: TCheckBox; 28 25 chkCVNo: TCheckBox; 26 chkSHDYes: TCheckBox; 27 chkSHDNo: TCheckBox; 28 lblSCNo: TStaticText; 29 lblSCYes: TStaticText; 29 30 procedure chkClick(Sender: TObject); 30 31 private … … 33 34 procedure SetCheckState(CheckYes, CheckNo: TCheckBox; CheckState: Integer); 34 35 function GetCheckState(CheckYes, CheckNo: TCheckBox): Integer; 36 35 37 public 36 38 constructor Create(AOwner: TComponent); override; 37 39 procedure GetRelated(PCEData: TPCEData); overload; 38 40 procedure GetRelated(var ASCRelated, AAORelated, AIRRelated, 39 AECRelated, AMSTRelated, AHNCRelated, ACVRelated : integer); overload;41 AECRelated, AMSTRelated, AHNCRelated, ACVRelated,ASHDRelated: integer); overload; 40 42 procedure InitAllow(SCCond: TSCConditions); 41 43 procedure InitRelated(PCEData: TPCEData); overload; 42 44 procedure InitRelated(const ASCRelated, AAORelated, AIRRelated, 43 AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer); overload; 45 AECRelated, AMSTRelated, AHNCRelated, ACVRelated,ASHDRelated: integer); overload; 46 44 47 end; 45 48 46 49 implementation 50 51 uses VA508AccessibilityRouter; 47 52 48 53 {$R *.DFM} … … 56 61 TAG_HNCYES = 6; 57 62 TAG_CVYES = 7; 63 TAG_SHDYES = 8; 58 64 TAG_SCNO = 11; 59 65 TAG_AONO = 12; … … 63 69 TAG_HNCNO = 16; 64 70 TAG_CVNO = 17; 71 TAG_SHDNO = 18; 72 65 73 66 74 procedure TfraVisitRelated.chkClick(Sender: TObject); … … 74 82 inherited; 75 83 if Sender is TCheckBox then with TCheckBox(Sender) do case Tag of 76 TAG_SCYES: if Checked then chkSCNo.Checked := False; 77 TAG_AOYES: if Checked then chkAONo.Checked := False; 78 TAG_IRYES: if Checked then chkIRNo.Checked := False; 79 TAG_ECYES: if Checked then chkECNo.Checked := False; 80 TAG_MSTYES: if Checked then chkMSTNo.Checked := False; 81 TAG_HNCYES: if Checked then chkHNCNo.Checked := False; 82 TAG_CVYES: if Checked then chkCVNo.Checked := False; 83 TAG_SCNO: if Checked then chkSCYes.Checked := False; 84 TAG_AONO: if Checked then chkAOYes.Checked := False; 85 TAG_IRNO: if Checked then chkIRYes.Checked := False; 86 TAG_ECNO: if Checked then chkECYes.Checked := False; 87 TAG_MSTNO: if Checked then chkMSTYes.Checked := False; 88 TAG_HNCNO: if Checked then chkHNCYes.Checked := False; 89 TAG_CVNO: if Checked then chkCVYes.Checked := False; 84 TAG_SCYES: if Checked then chkSCNo.Checked := False; 85 TAG_AOYES: if Checked then chkAONo.Checked := False; 86 TAG_IRYES: if Checked then chkIRNo.Checked := False; 87 TAG_ECYES: if Checked then chkECNo.Checked := False; 88 TAG_MSTYES: if Checked then chkMSTNo.Checked := False; 89 TAG_HNCYES: if Checked then chkHNCNo.Checked := False; 90 TAG_CVYES: if Checked then chkCVNo.Checked := False; 91 TAG_SHDYES: if Checked then chkSHDNo.Checked := False; 92 TAG_SCNO: if Checked then chkSCYes.Checked := False; 93 TAG_AONO: if Checked then chkAOYes.Checked := False; 94 TAG_IRNO: if Checked then chkIRYes.Checked := False; 95 TAG_ECNO: if Checked then chkECYes.Checked := False; 96 TAG_MSTNO: if Checked then chkMSTYes.Checked := False; 97 TAG_HNCNO: if Checked then chkHNCYes.Checked := False; 98 TAG_CVNO: if Checked then chkCVYes.Checked := False; 99 TAG_SHDNO: if Checked then chkSHDYes.Checked := False; 90 100 end; 91 101 if chkSCYes.Checked then … … 94 104 DisableCheck(chkIRYes); 95 105 DisableCheck(chkECYes); 106 DisableCheck(chkSHDYes); 96 107 // DisableCheck(chkMSTYes); 97 108 DisableCheck(chkAONo); 98 109 DisableCheck(chkIRNo); 99 110 DisableCheck(chkECNo); 111 DisableCheck(chkSHDNo); 100 112 // DisableCheck(chkMSTNo); 101 113 end else … … 105 117 SetCheckEnable(chkIRYes, chkIRNo, FSCCond.IRAllow); 106 118 SetCheckEnable(chkECYes, chkECNo, FSCCond.ECAllow); 119 SetCheckEnable(chkSHDYEs, chkSHDNo, FSCCond.SHDAllow); 107 120 end; 108 121 SetCheckEnable(chkMSTYes, chkMSTNo, FSCCond.MSTAllow); 109 122 SetCheckEnable(chkHNCYes, chkHNCNo, FSCCond.HNCAllow); 110 SetCheckEnable(chkCVYes, chkCVNo, FSCCond.CVAllow); 111 if chkAOYes.Checked or chkIRYes.Checked or chkECYes.Checked then //or chkMSTYes.Checked then 112 begin 113 chkSCYes.Checked := False; 114 chkSCNo.Checked := True; 123 SetCheckEnable(chkCVYes, chkCVNo, FSCCond.CVAllow); 124 125 if chkAOYes.Checked or chkIRYes.Checked or chkECYes.Checked or chkSHDYes.Checked then //or chkMSTYes.Checked then 126 begin 127 if FSCCond.SCAllow then 128 begin 129 chkSCYes.Checked := False; 130 chkSCNo.Checked := True; 131 end; 115 132 end; 116 133 end; … … 118 135 constructor TfraVisitRelated.Create(AOwner: TComponent); 119 136 begin 120 inherited ;121 137 inherited Create(AOwner); 138 TabStop := FALSE; 122 139 lblSCYes.Height := 13; 123 140 lblSCNo.Height := 13; 124 // chkHNCYes.Visible := HNCOK;125 // chkHNCNo.Visible := HNCOK;126 // if not HNCOK then127 // begin128 // height := height - chkHNCYes.height + 1;129 // bvlSCFrame.height := bvlSCFrame.height - chkHNCYes.height + 1;130 // end;131 141 end; 132 142 … … 147 157 PCEData.HNCRelated := GetCheckState(chkHNCYes, chkHNCNo); 148 158 PCEData.CVRelated := GetCheckState(chkCVYes, chkCVNo); 159 PCEData.SHADRelated := GetCheckState(chkSHDYes, chkSHDNo); 149 160 end; 150 161 151 162 procedure TfraVisitRelated.GetRelated(var ASCRelated, AAORelated, 152 AIRRelated, AECRelated, AMSTRelated, AHNCRelated, ACVRelated : integer);163 AIRRelated, AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHDRelated: integer); 153 164 begin 154 165 ASCRelated := GetCheckState(chkSCYes, chkSCNo); … … 159 170 AHNCRelated := GetCheckState(chkHNCYes, chkHNCNo); 160 171 ACVRelated := GetCheckState(chkCVYes, chkCVNo); 172 ASHDRelated := GetCheckState(chkSHDYes, chkSHDNo); 161 173 end; 162 174 … … 173 185 SetCheckEnable(chkHNCYes, chkHNCNo, HNCAllow); 174 186 SetCheckEnable(chkCVYes, chkCVNo, CVAllow); 187 SetCheckEnable(chkSHDYes, chkSHDNo, SHDAllow); 175 188 end; 176 189 end; … … 185 198 SetCheckState(chkHNCYes, chkHNCNo, PCEData.HNCRelated); 186 199 SetCheckState(chkCVYes, chkCVNo, PCEData.CVRelated); 200 SetCheckState(chkSHDYes, chkSHDNo, PCEData.SHADRelated); 201 //HDS00015356: GWOT Default, if Related no specified default to "Yes" 202 // -1=Null, 0=No, 1 = Yes 203 if FSCCond.CVAllow then 204 begin 205 if PCEData.CVRelated = SCC_NA then 206 chkCVYes.Checked := True; 207 end; 187 208 end; 188 209 189 210 procedure TfraVisitRelated.InitRelated(const ASCRelated, AAORelated, AIRRelated, 190 AECRelated, AMSTRelated, AHNCRelated, ACVRelated : integer);211 AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHDRelated: integer); 191 212 begin 192 213 SetCheckState(chkSCYes, chkSCNo, ASCRelated); … … 197 218 SetCheckState(chkHNCYes, chkHNCNo, AHNCRelated); 198 219 SetCheckState(chkCVYes, chkCVNo, ACVRelated); 220 SetCheckState(chkSHDYes, chkSHDNo, ASHDRelated); 221 //HDS00015356: GWOT Default, if Related no specified default to "Yes" 222 // -1=Null, 0=No, 1 = Yes 223 if FSCCond.CVAllow then 224 begin 225 if ACVRelated = SCC_NA then 226 chkCVYes.Checked := True; 227 end; 199 228 end; 200 229 … … 226 255 end; 227 256 257 258 initialization 259 SpecifyFormIsNotADialog(TfraVisitRelated); 260 228 261 end. -
cprs/trunk/CPRS-Chart/Encounter/rPCE.pas
r456 r829 42 42 HNCAllow: Boolean; // prompt for Head or Neck Cancer 43 43 HNCDflt: Boolean; // default if prompting Head or Neck Cancer 44 CVAllow: Boolean; // prompt for Combat Veteran Related 45 CVDflt: Boolean; // default if prompting Comabt Veteran 44 CVAllow: Boolean; // prompt for Combat Veteran Related 45 CVDflt: Boolean; // default if prompting Comabt Veteran 46 SHDAllow: Boolean; // prompt for Shipboard Hazard and Defense 47 SHDDflt: Boolean; // default if prompting Shipboard Hazard and Defense 46 48 end; 47 49 … … 149 151 ANoteIEN: integer): string; 150 152 function IsUserAProvider(AUser: Int64; ADate: TFMDateTime): boolean; 153 function IsUserAUSRProvider(AUser: Int64; ADate: TFMDateTime): boolean; 151 154 function IsCancelOrNoShow(ANote: integer): boolean; 152 155 function IsNonCountClinic(ALocation: integer): boolean; … … 242 245 end; 243 246 CallV('ORWPCE LEX', [x, CodeSys, ADate]); 244 Dest.Assign(RPCBrokerV.Results);247 FastAssign(RPCBrokerV.Results, Dest); 245 248 end; 246 249 … … 405 408 uVTypeLastDate := EncDt; 406 409 end; 407 Dest.Assign(uVTypeForLoc);410 FastAssign(uVTypeForLoc, Dest); 408 411 end; 409 412 … … 1072 1075 CVAllow := Piece(Piece(x, ';', 7), U, 1) = '1'; 1073 1076 CVDflt := Piece(Piece(x, ';', 7), U, 2) = '1'; 1077 SHDAllow := Piece(Piece(x, ';', 8), U, 1) = '1'; 1078 SHDDflt := Piece(Piece(x, ';', 8), U, 2) = '1'; 1074 1079 end; 1075 1080 end; … … 1079 1084 begin 1080 1085 CallV('ORWPCE SCDIS', [Patient.DFN]); 1081 Dest.Assign(RPCBrokerV.Results);1086 FastAssign(RPCBrokerV.Results, Dest); 1082 1087 end; 1083 1088 … … 1088 1093 else 1089 1094 CallV('ORWPCE PCE4NOTE', [ANoteIEN]); 1090 Dest.Assign(RPCBrokerV.Results);1095 FastAssign(RPCBrokerV.Results, Dest); 1091 1096 end; 1092 1097 … … 1155 1160 end; 1156 1161 end; 1157 uHasCPT.AddStrings(RPCBrokerV.Results);1162 FastAddStrings(RPCBrokerV.Results, uHasCPT); 1158 1163 end; 1159 1164 end; … … 1219 1224 begin 1220 1225 if idx = 0 then 1221 tCallV(TmpSL,RPC,[nil]) 1226 begin 1227 if (typ = 1) or (typ = 2) then 1228 tCallV(TmpSL,RPC,[uEncPCEData.VisitDateTime]) 1229 else 1230 tCallV(TmpSL,RPC,[nil]); 1231 end 1222 1232 else 1223 1233 tCallV(TmpSL,RPC,[idx]); … … 1244 1254 end; 1245 1255 end; 1246 Dest.Assign(TmpSL);1256 FastAssign(TmpSL, Dest); 1247 1257 finally 1248 1258 TmpSL.Free; … … 1454 1464 end; 1455 1465 1466 function IsUserAUSRProvider(AUser: Int64; ADate: TFMDateTime): boolean; 1467 begin 1468 Result := (sCallV('TIU IS USER A USR PROVIDER', [AUser, ADate]) = '1'); 1469 end; 1470 1456 1471 //function HNCOK: boolean; 1457 1472 //begin -
cprs/trunk/CPRS-Chart/Encounter/uPCE.pas
r456 r829 1 1 unit uPCE; 2 2 3 3 interface 4 4 … … 220 220 FHNCRelated: Integer; // 221 221 FCVRelated: Integer; // 222 FSHADRelated: Integer; // 222 223 FVisitType: TPCEProc; // 223 224 FProviders: TPCEProviderList; … … 248 249 procedure SetHNCRelated(Value: Integer); 249 250 procedure SetCVRelated(Value: Integer); 251 procedure SetSHADRelated(Value: Integer); 250 252 procedure SetEncUseCurr(Value: Boolean); 251 253 function GetHasData: Boolean; … … 286 288 function StrExams: string; 287 289 function StrVisitType(const ASCRelated, AAORelated, AIRRelated, AECRelated, 288 AMSTRelated, AHNCRelated, ACVRelated : Integer): string; overload;290 AMSTRelated, AHNCRelated, ACVRelated, ASHADRelated: Integer): string; overload; 289 291 function StrVisitType: string; overload; 290 292 function StandAlone: boolean; … … 311 313 property HNCRelated: Integer read FHNCRelated write SetHNCRelated; 312 314 property CVRelated: Integer read FCVRelated write SetCVRelated; 315 property SHADRelated: Integer read FSHADRelated write SetSHADRelated; 313 316 property VisitType: TPCEProc read FVisitType write SetVisitType; 314 317 property VisitString: string read GetVisitString; … … 596 599 begin 597 600 Result := PCESetsOfCodes.Add(Hdr); 598 PCESetsOfCodes.AddStrings(TempSL);601 FastAddStrings(TempSL, PCESetsOfCodes); 599 602 end; 600 603 finally … … 618 621 HistLocations.Insert(0,'0'); 619 622 end; 620 List.AddStrings(HistLocations);623 FastAddStrings(HistLocations, List); 621 624 end 622 625 else … … 754 757 begin 755 758 idx := PCESetsOfCodes.Add(Hdr); 756 PCESetsOfCodes.AddStrings(TempSL);759 FastAddStrings(TempSL, PCESetsOfCodes); 757 760 end; 758 761 finally … … 1639 1642 FHNCRelated := SCC_NA; 1640 1643 FCVRelated := SCC_NA; 1644 FSHADRelated := SCC_NA; 1641 1645 FSCChanged := False; 1642 1646 end; … … 1695 1699 FHNCRelated := SCC_NA; 1696 1700 FCVRelated := SCC_NA; 1701 FSHADRelated := SCC_NA; 1697 1702 1698 1703 ClearList(FDiagnoses); … … 2075 2080 if(FileCat = 'E') and (FHistoricalLocation <> '') then 2076 2081 Add('VST^OL^' + FHistoricalLocation); // Outside Location 2077 2078 //Add('PRV^' + IntToStr(FEncProvider)); // Encounter Provider 2079 //Add('PRV^' + IntToStr(UProvider.IEN)); // Encounter Provider 2080 {with FProviders do for i := 0 to Count - 1 do with TPCEProvider(Items[i]) do 2081 begin 2082 PCEList.Add(DelimitedStr); 2083 end;} 2084 PCEList.AddStrings(FProviders); 2085 2082 FastAddStrings(FProviders, PCEList); 2083 2086 2084 if FSCChanged then 2087 2085 begin 2088 if FSCRelated <> SCC_NA then Add('VST^SC^' + IntToStr(FSCRelated));2089 if FAORelated <> SCC_NA then Add('VST^AO^' + IntToStr(FAORelated));2090 if FIRRelated <> SCC_NA then Add('VST^IR^' + IntToStr(FIRRelated));2091 if FECRelated <> SCC_NA then Add('VST^EC^' + IntToStr(FECRelated));2092 if FMSTRelated <> SCC_NA then Add('VST^MST^' + IntToStr(FMSTRelated));2093 // if HNCOK and (FHNCRelated <> SCC_NA) then 2094 if F HNCRelated <> SCC_NA then Add('VST^HNC^' + IntToStr(FHNCRelated));2095 if F CVRelated <> SCC_NA then Add('VST^CV^' + IntToStr(FCVRelated));2086 if FSCRelated <> SCC_NA then Add('VST^SC^' + IntToStr(FSCRelated)); 2087 if FAORelated <> SCC_NA then Add('VST^AO^' + IntToStr(FAORelated)); 2088 if FIRRelated <> SCC_NA then Add('VST^IR^' + IntToStr(FIRRelated)); 2089 if FECRelated <> SCC_NA then Add('VST^EC^' + IntToStr(FECRelated)); 2090 if FMSTRelated <> SCC_NA then Add('VST^MST^' + IntToStr(FMSTRelated)); 2091 if FHNCRelated <> SCC_NA then Add('VST^HNC^'+ IntToStr(FHNCRelated)); 2092 if FCVRelated <> SCC_NA then Add('VST^CV^' + IntToStr(FCVRelated)); 2093 if FSHADRelated <> SCC_NA then Add('VST^SHD^'+ IntToStr(FSHADRelated)); 2096 2094 end; 2097 2095 with FDiagnoses do for i := 0 to Count - 1 do with TPCEDiag(Items[i]) do … … 2266 2264 begin 2267 2265 Result := -1; 2268 // with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then2269 2266 with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then 2270 // with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) then2271 2267 begin 2272 2268 Result := i; … … 2289 2285 begin 2290 2286 PostItem := TPCEItem(Objects[j]); 2291 // if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;2292 2287 if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True; 2293 // if (PreItem.Match(PostItem)) then MatchFound := True;2294 2288 end; 2295 2289 if not MatchFound then … … 2423 2417 if CurImmunization.Reaction = '' then CurImmunization.Reaction := NoPCEValue; 2424 2418 2425 // if (SrcImmunization.Provider <> CurImmunization.Provider) or2426 2419 if(SrcImmunization.Series <> CurImmunization.Series) or 2427 2420 (SrcImmunization.Reaction <> CurImmunization.Reaction) or … … 2430 2423 (CurImmunization.Comment <> SrcImmunization.Comment)then 2431 2424 begin 2432 // CurImmunization.Provider := SrcImmunization.Provider;2433 2425 CurImmunization.Series := SrcImmunization.Series; 2434 2426 CurImmunization.Reaction := SrcImmunization.Reaction; … … 2465 2457 if CurSkinTest.Results = '' then CurSkinTest.Results := NoPCEValue; 2466 2458 if SrcSkinTest.Results = '' then SrcSkinTest.Results := NoPCEValue; 2467 // if (SrcSkinTest.Provider <> CurSkinTest.Provider) or 2459 2468 2460 if(SrcSkinTest.Results <> CurSkinTest.Results) or 2469 2461 (SrcSkinTest.Reading <> CurSkinTest.Reading) or 2470 (CurSkinTest.Comment <> SrcSkinTest.Comment) then 2471 begin 2472 // CurSkinTest.Provider := SrcSkinTest.Provider; 2462 (CurSkinTest.Comment <> SrcSkinTest.Comment) then 2463 begin 2464 2473 2465 CurSkinTest.Results := SrcSkinTest.Results; 2474 2466 CurSkinTest.Reading := SrcSkinTest.Reading; 2475 CurSkinTest.Comment := SrcSkinTest.Comment; 2467 CurSkinTest.Comment := SrcSkinTest.Comment; 2476 2468 CurSkinTest.FSend := True; 2477 2469 end; … … 2502 2494 if CurPatientEd.level = '' then CurPatientEd.level := NoPCEValue; 2503 2495 if SrcPatientEd.level = '' then SrcPatientEd.level := NoPCEValue; 2504 // if (SrcPatientEd.Provider <> CurPatientEd.Provider) or2505 2496 if(SrcPatientEd.Level <> CurPatientEd.Level) or 2506 2497 (CurPatientEd.Comment <> SrcPatientEd.Comment) then 2507 2498 begin 2508 // CurPatientEd.Provider := SrcPatientEd.Provider;2509 2499 CurPatientEd.Level := SrcPatientEd.Level; 2510 2500 CurPatientEd.Comment := SrcPatientEd.Comment; … … 2539 2529 if CurHealthFactor.level = '' then CurHealthFactor.level := NoPCEValue; 2540 2530 if SrcHealthFactor.level = '' then SrcHealthFactor.level := NoPCEValue; 2541 // if (SrcHealthFactor.Provider <> CurHealthFactor.Provider) or2542 2531 if(SrcHealthFactor.Level <> CurHealthFactor.Level) or 2543 2532 (CurHealthFactor.Comment <> SrcHealthFactor.Comment) then 2544 2533 begin 2545 // CurHealthFactor.Provider := SrcHealthFactor.Provider;2546 2534 CurHealthFactor.Level := SrcHealthFactor.Level; 2547 2535 CurHealthFactor.Comment := SrcHealthFactor.Comment; … … 2578 2566 if CurExam.Results = '' then CurExam.Results := NoPCEValue; 2579 2567 if SrcExam.Results = '' then SrcExam.Results := NoPCEValue; 2580 // if (SrcExam.Provider <> CurExam.Provider) or2581 2568 if(SrcExam.Results <> CurExam.Results) or 2582 2569 (CurExam.Comment <> SrcExam.Comment) then 2583 2570 begin 2584 // CurExam.Provider := SrcExam.Provider;2585 2571 CurExam.Results := SrcExam.Results; 2586 2572 CurExam.Comment := SrcExam.Comment; … … 2683 2669 end; 2684 2670 2671 procedure TPCEData.SetSHADRelated(Value: Integer); 2672 begin 2673 if (Value <> FSHADRelated) then 2674 begin 2675 FSHADRelated := Value; 2676 FSCChanged := True; 2677 end; 2678 end; 2679 2685 2680 procedure TPCEData.SetEncUseCurr(Value: Boolean); 2686 2681 begin … … 2694 2689 FStandAlone := Encounter.StandAlone; 2695 2690 FStandAloneLoaded := TRUE; 2696 //FCPTRequired := Encounter.StandAlone;2697 2691 FEncInpatient := Encounter.Inpatient; 2698 //if FEncInpatient then FCPTRequired := False; 2699 //SetDefaultProvider(FProviders, FEncLocation, FNoteIEN, PersonClassDate); 2692 2700 2693 end else 2701 2694 begin … … 2706 2699 FProviders.PrimaryIdx := -1; 2707 2700 FEncSvcCat := 'A'; 2708 //FCPTRequired := False;2709 2701 FEncInpatient := False; 2710 2702 end; 2711 2703 // 2712 2704 SetRPCEncLocation(FEncLocation); 2713 // SetRPCEncDateTime(FEncDateTime);2714 2705 end; 2715 2706 … … 2798 2789 2799 2790 function TPCEData.StrVisitType(const ASCRelated, AAORelated, AIRRelated, 2800 AECRelated, AMSTRelated, AHNCRelated, ACVRelated : Integer): string;2791 AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHADRelated: Integer): string; 2801 2792 { returns as a string the type of encounter (according to CPT) & related contitions treated } 2802 2793 … … 2832 2823 end; 2833 2824 Result := Trim(Result + StrVisitType(FSCRelated, FAORelated, FIRRelated, 2834 FECRelated, FMSTRelated, FHNCRelated, FCVRelated ));2825 FECRelated, FMSTRelated, FHNCRelated, FCVRelated, FSHADRelated)); 2835 2826 end; 2836 2827 … … 2901 2892 Dest.FHNCRelated := FHNCRelated; 2902 2893 Dest.FCVRelated := FCVRelated; 2894 Dest.FSHADRelated := FSHADRelated; 2903 2895 FVisitType.CopyProc(Dest.VisitType); 2904 2896 Dest.FProviders.Assign(FProviders); … … 2928 2920 if(not FutureEncounter(Self)) then 2929 2921 begin 2930 // if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone) or CPTRequiredForNote(FNoteIEN)) then2931 2922 if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone)) then 2932 2923 begin … … 2959 2950 // if HNCOK and (EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE; 2960 2951 if(EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE; 2961 if(EC.CVAllow and (CVRelated = SCC_NA) ) then NeedSC := TRUE;2952 if(EC.CVAllow and (CVRelated = SCC_NA) and (SHADRelated = SCC_NA)) then NeedSC := TRUE; 2962 2953 if(NeedSC) then 2963 2954 Include(Result, ndSC); … … 3274 3265 if(Result) then Result := (FHNCRelated = SCC_NA); 3275 3266 if(Result) then Result := (FCVRelated = SCC_NA); 3267 if(Result) then Result := (FSHADRelated = SCC_NA); 3276 3268 if(Result) then Result := (FDiagnoses.Count = 0); 3277 3269 if(Result) then Result := (FProcedures.Count = 0); -
cprs/trunk/CPRS-Chart/Orders/fOCAccept.dfm
r456 r829 3 3 Top = 257 4 4 BorderIcons = [] 5 BorderStyle = bsDialog6 5 Caption = 'Order Checking' 7 6 ClientHeight = 169 8 7 ClientWidth = 472 9 8 Position = poScreenCenter 9 ExplicitLeft = 305 10 ExplicitTop = 257 11 ExplicitWidth = 480 12 ExplicitHeight = 203 10 13 PixelsPerInch = 96 11 14 TextHeight = 13 12 object memChecks: TRichEdit 15 object memChecks: TRichEdit [0] 13 16 Left = 0 14 17 Top = 0 … … 21 24 WantReturns = False 22 25 end 23 object pnlBottom: TPanel 26 object pnlBottom: TPanel [1] 24 27 Left = 0 25 28 Top = 136 … … 50 53 end 51 54 end 55 inherited amgrMain: TVA508AccessibilityManager 56 Data = ( 57 ( 58 'Component = memChecks' 59 'Status = stsDefault') 60 ( 61 'Component = pnlBottom' 62 'Status = stsDefault') 63 ( 64 'Component = cmdAccept' 65 'Status = stsDefault') 66 ( 67 'Component = cmdCancel' 68 'Status = stsDefault') 69 ( 70 'Component = frmOCAccept' 71 'Status = stsDefault')) 72 end 52 73 end -
cprs/trunk/CPRS-Chart/Orders/fOCAccept.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls ;7 fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOCSession.dfm
r456 r829 1 1 inherited frmOCSession: TfrmOCSession 2 Left = 365 3 Top = 221 4 Width = 504 5 Height = 298 2 Left = 366 3 Top = 222 6 4 BorderIcons = [] 7 5 Caption = 'Order Checks' 6 ClientWidth = 494 8 7 Position = poScreenCenter 9 8 ShowHint = True 10 9 OnClose = FormClose 11 10 OnShow = FormShow 11 ExplicitWidth = 502 12 ExplicitHeight = 240 12 13 PixelsPerInch = 96 13 14 TextHeight = 13 14 object lstChecks: TCaptionListBox 15 object lstChecks: TCaptionListBox [0] 15 16 Left = 0 16 17 Top = 0 17 Width = 49 618 Height = 16 018 Width = 494 19 Height = 162 19 20 Style = lbOwnerDrawVariable 20 21 Align = alClient … … 28 29 HintOnItem = True 29 30 end 30 object pnlBottom: TPanel 31 object pnlBottom: TPanel [1] 31 32 Left = 0 32 Top = 16 033 Width = 49 633 Top = 162 34 Width = 494 34 35 Height = 111 35 36 Align = alBottom … … 37 38 TabOrder = 0 38 39 DesignSize = ( 39 49 640 494 40 41 111) 41 42 object lblJustify: TLabel 42 Left = 843 Left = 9 43 44 Top = 34 44 45 Width = 248 … … 50 51 Left = 8 51 52 Top = 50 52 Width = 4 8053 Width = 478 53 54 Height = 21 54 55 Anchors = [akLeft, akTop, akRight] … … 61 62 Left = 356 62 63 Top = 5 63 Width = 13 364 Width = 131 64 65 Height = 21 65 66 Anchors = [akLeft, akTop, akRight] 66 67 Caption = 'Cancel Selected Order(s)' 67 TabOrder = 268 TabOrder = 3 68 69 OnClick = cmdCancelOrderClick 69 70 end 70 71 object cmdContinue: TButton 71 Left = 21272 Left = 157 72 73 Top = 82 73 Width = 7 274 Width = 70 74 75 Height = 21 75 Anchors = [akLeft, akTop, akRight]76 76 Caption = 'Continue' 77 TabOrder = 377 TabOrder = 4 78 78 OnClick = cmdContinueClick 79 79 end 80 object btnReturn: TButton 81 Left = 241 82 Top = 82 83 Width = 97 84 Height = 21 85 Cancel = True 86 Caption = 'Return to Orders' 87 TabOrder = 5 88 OnClick = btnReturnClick 89 end 90 object memNote: TMemo 91 Left = 8 92 Top = 4 93 Width = 329 94 Height = 29 95 BorderStyle = bsNone 96 Color = clBtnFace 97 Lines.Strings = ( 98 'NOTE: The override justification is for tracking purposes and ' 99 'does not change or place new order(s).') 100 ReadOnly = True 101 TabOrder = 1 102 OnEnter = memNoteEnter 103 end 104 end 105 inherited amgrMain: TVA508AccessibilityManager 106 Data = ( 107 ( 108 'Component = lstChecks' 109 'Status = stsDefault') 110 ( 111 'Component = pnlBottom' 112 'Status = stsDefault') 113 ( 114 'Component = txtJustify' 115 'Status = stsDefault') 116 ( 117 'Component = cmdCancelOrder' 118 'Status = stsDefault') 119 ( 120 'Component = cmdContinue' 121 'Status = stsDefault') 122 ( 123 'Component = btnReturn' 124 'Status = stsDefault') 125 ( 126 'Component = memNote' 127 'Status = stsDefault') 128 ( 129 'Component = frmOCSession' 130 'Status = stsDefault')) 80 131 end 81 132 end -
cprs/trunk/CPRS-Chart/Orders/fOCSession.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls ;7 fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager; 8 8 9 9 type … … 15 15 cmdCancelOrder: TButton; 16 16 cmdContinue: TButton; 17 btnReturn: TButton; 18 memNote: TMemo; 17 19 procedure cmdCancelOrderClick(Sender: TObject); 18 20 procedure cmdContinueClick(Sender: TObject); … … 26 28 procedure txtJustifyKeyDown(Sender: TObject; var Key: Word; 27 29 Shift: TShiftState); 30 procedure btnReturnClick(Sender: TObject); 31 procedure memNoteEnter(Sender: TObject); 28 32 private 29 33 FCritical: Boolean; 34 FCancelSignProcess : Boolean; 30 35 FCheckList: TStringList; 31 36 FOrderList: TStringList; 32 37 procedure SetReqJustify; 38 procedure SetReturn(const Value: Boolean); 33 39 public 34 40 { Public declarations } 41 property CancelSignProcess : Boolean read FCancelSignProcess write SetReturn default false; 35 42 end; 36 43 37 44 procedure ExecuteReleaseOrderChecks(SelectList: TList); 38 procedure ExecuteSessionOrderChecks(OrderList: TStringList);45 function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean; 39 46 40 47 implementation … … 42 49 {$R *.DFM} 43 50 44 uses rOrders, uCore, rMisc ;51 uses rOrders, uCore, rMisc, fFrame; 45 52 46 53 type … … 84 91 OrderIDList.Add(AnOrder.ID + '^^1'); // 3rd pce = 1 means releasing order 85 92 end; 86 ExecuteSessionOrderChecks(OrderIDList); 87 for i := SelectList.Count - 1 downto 0 do 88 begin 89 AnOrder := TOrder(SelectList.Items[i]); 90 if OrderIDList.IndexOf(AnOrder.ID + '^^1') < 0 then 93 if ExecuteSessionOrderChecks(OrderIDList) then 94 for i := SelectList.Count - 1 downto 0 do 91 95 begin 92 Changes.Remove(CH_ORD, AnOrder.ID); 93 SelectList.Delete(i); 94 end; 95 end; 96 AnOrder := TOrder(SelectList.Items[i]); 97 if OrderIDList.IndexOf(AnOrder.ID + '^^1') < 0 then 98 begin 99 Changes.Remove(CH_ORD, AnOrder.ID); 100 SelectList.Delete(i); 101 end; 102 end 103 else 104 SelectList.Clear; 96 105 finally 97 106 OrderIDList.Free; … … 99 108 end; 100 109 101 procedure ExecuteSessionOrderChecks(OrderList: TStringList); 110 {Returns True if the Signature process should proceed. 111 Clears OrderList If False. } 112 function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean; 102 113 var 103 114 i, j: Integer; … … 109 120 x: string; 110 121 begin 122 Result := True; 111 123 CheckList := TStringList.Create; 112 124 try … … 152 164 if frmOCSession.Visible then frmOCSession.SetFocus; 153 165 frmOCSession.ShowModal; 166 Result := not frmOCSession.CancelSignProcess; 167 if frmOCSession.CancelSignProcess then begin 168 OrderList.Clear; 169 if Assigned(frmFrame) then 170 frmFrame.SetActiveTab(CT_ORDERS); 171 end; 154 172 finally 155 173 with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free; … … 176 194 lblJustify.Visible := FCritical; 177 195 txtJustify.Visible := FCritical; 196 memNote.Visible := FCritical; 178 197 179 198 end; … … 234 253 if (Piece(OCRec.Checks[i], U, 2) = '1') then 235 254 begin 236 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then 237 Canvas.Font.Color := clBlue; 255 Canvas.Font.Color := Get508CompliantColor(clBlue); 238 256 Canvas.Font.Style := [fsUnderline]; 239 257 end … … 298 316 inherited; 299 317 SetFormPosition(Self); //Get Saved Position & Size of Form 318 FCancelSignProcess := False; 300 319 end; 301 320 … … 315 334 end; 316 335 336 procedure TfrmOCSession.btnReturnClick(Sender: TObject); 337 begin 338 inherited; 339 FCancelSignProcess := True; 340 Close; 341 end; 342 343 procedure TfrmOCSession.SetReturn(const Value: Boolean); 344 begin 345 FCancelSignProcess := Value; 346 end; 347 348 procedure TfrmOCSession.memNoteEnter(Sender: TObject); 349 begin 350 inherited; 351 memNote.SelStart := 0; 352 end; 353 317 354 end. -
cprs/trunk/CPRS-Chart/Orders/fODActive.dfm
r456 r829 1 objectfrmODActive: TfrmODActive1 inherited frmODActive: TfrmODActive 2 2 Left = 267 3 3 Top = 216 4 Width = 5475 Height = 3506 4 Caption = 'Copy active orders for selected event' 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 = [] 5 ClientHeight = 316 6 ClientWidth = 539 13 7 OldCreateOrder = False 14 8 Position = poScreenCenter 15 9 OnCreate = FormCreate 16 OnDestroy = FormDestroy 10 ExplicitWidth = 320 11 ExplicitHeight = 240 17 12 PixelsPerInch = 96 18 13 TextHeight = 13 19 object lblCaption: TLabel 14 object lblCaption: TLabel [0] 20 15 Left = 0 21 16 Top = 0 … … 28 23 WordWrap = True 29 24 end 30 object pnlClient: TPanel 25 object pnlClient: TPanel [1] 31 26 Left = 0 32 27 Top = 29 33 28 Width = 539 34 Height = 2 9329 Height = 287 35 30 Align = alClient 36 31 BevelOuter = bvNone 37 32 Locked = True 38 33 TabOrder = 0 34 ExplicitHeight = 294 39 35 DesignSize = ( 40 36 539 41 2 93)37 287) 42 38 object btnOK: TButton 43 39 Left = 386 … … 81 77 Width = 539 82 78 Height = 21 83 DragReorder = False84 79 Sections = < 85 80 item … … 110 105 end 111 106 end 107 inherited amgrMain: TVA508AccessibilityManager 108 Data = ( 109 ( 110 'Component = pnlClient' 111 'Status = stsDefault') 112 ( 113 'Component = btnOK' 114 'Status = stsDefault') 115 ( 116 'Component = btnCancel' 117 'Status = stsDefault') 118 ( 119 'Component = lstActiveOrders' 120 'Status = stsDefault') 121 ( 122 'Component = hdControl' 123 'Status = stsDefault') 124 ( 125 'Component = frmODActive' 126 'Status = stsDefault')) 127 end 112 128 end -
cprs/trunk/CPRS-Chart/Orders/fODActive.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,rOrders,fOrders,uOrders, 8 fFrame,ORCtrls,fAutoSz ;8 fFrame,ORCtrls,fAutoSz, VA508AccessibilityManager; 9 9 10 10 type … … 48 48 implementation 49 49 50 uses 51 VA2006Utils; 52 50 53 {$R *.DFM} 51 54 … … 83 86 DoesDestEvtOccur:boolean; 84 87 begin 88 try 89 self.btnOK.Enabled := false; 85 90 DoesDestEvtOccur := False; 86 91 uAutoAC := True; … … 104 109 uAutoAC := False; 105 110 end; 111 finally 112 self.btnOK.Enabled := True; 113 end; 106 114 Close; 107 115 end; … … 114 122 procedure TfrmODActive.FormCreate(Sender: TObject); 115 123 begin 124 FixHeaderControlDelphi2006Bug(hdControl); 116 125 ActiveOrderList := TList.Create; 117 126 FOrderView := TOrderView.Create; … … 208 217 ARect := TheeRect; 209 218 Canvas.FillRect(ARect); 210 Canvas.Pen.Color := clSilver;219 Canvas.Pen.Color := Get508CompliantColor(clSilver); 211 220 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); 212 221 Canvas.LineTo(ARect.Right, ARect.Bottom - 1); -
cprs/trunk/CPRS-Chart/Orders/fODAllgy.dfm
r456 r829 5 5 Height = 339 6 6 HorzScrollBar.Range = 520 7 HorzScrollBar.Visible = True8 7 VertScrollBar.Range = 312 9 VertScrollBar.Visible = True10 AutoScroll = False11 8 Caption = 'Enter Allergy Information' 9 ExplicitHeight = 339 12 10 PixelsPerInch = 96 13 11 TextHeight = 13 … … 142 140 Top = 256 143 141 TabOrder = 16 142 ExplicitLeft = 5 143 ExplicitTop = 256 144 144 end 145 145 inherited cmdAccept: TButton … … 148 148 Caption = 'Accept' 149 149 TabOrder = 13 150 ExplicitLeft = 441 151 ExplicitTop = 256 150 152 end 151 153 inherited cmdQuit: TButton … … 153 155 Top = 283 154 156 TabOrder = 14 157 ExplicitLeft = 441 158 ExplicitTop = 283 155 159 end 156 160 inherited pnlMessage: TPanel … … 158 162 Top = 253 159 163 TabOrder = 15 164 ExplicitLeft = 20 165 ExplicitTop = 253 160 166 inherited memMessage: TRichEdit 161 167 Left = 41 168 ExplicitLeft = 41 162 169 end 163 170 end 164 object cboReactionType: TORComboBox 171 object cboReactionType: TORComboBox [15] 165 172 Left = 7 166 173 Top = 96 … … 186 193 CharsNeedMatch = 1 187 194 end 188 object grpObsHist: TRadioGroup 195 object grpObsHist: TRadioGroup [16] 189 196 Left = 364 190 197 Top = 11 … … 200 207 OnClick = grpObsHistClick 201 208 end 202 object memComments: TRichEdit 209 object memComments: TRichEdit [17] 203 210 Left = 282 204 211 Top = 142 … … 210 217 OnKeyUp = memCommentsKeyUp 211 218 end 212 object lstSelectedSymptoms: TORListBox 219 object lstSelectedSymptoms: TORListBox [18] 213 220 Left = 147 214 221 Top = 143 … … 226 233 OnChange = ControlChange 227 234 end 228 object ckNoKnownAllergies: TCheckBox 235 object ckNoKnownAllergies: TCheckBox [19] 229 236 Left = 8 230 237 Top = 18 … … 235 242 OnClick = ckNoKnownAllergiesClick 236 243 end 237 object cboOriginator: TORComboBox 244 object cboOriginator: TORComboBox [20] 238 245 Left = 210 239 246 Top = 22 … … 263 270 CharsNeedMatch = 1 264 271 end 265 object cboSymptoms: TORComboBox 272 object cboSymptoms: TORComboBox [21] 266 273 Left = 7 267 274 Top = 143 … … 289 296 CharsNeedMatch = 1 290 297 end 291 object btnCurrent: TButton 298 object btnCurrent: TButton [22] 292 299 Left = 137 293 300 Top = 14 … … 298 305 OnClick = btnCurrentClick 299 306 end 300 object calObservedDate: TORDateBox 307 object calObservedDate: TORDateBox [23] 301 308 Left = 365 302 309 Top = 62 … … 309 316 Caption = 'Reaction Date/Time' 310 317 end 311 object cboSeverity: TORComboBox 318 object cboSeverity: TORComboBox [24] 312 319 Left = 365 313 320 Top = 97 … … 333 340 CharsNeedMatch = 1 334 341 end 335 object btnRemove: TButton 342 object btnRemove: TButton [25] 336 343 Left = 210 337 344 Top = 224 … … 342 349 OnClick = btnRemoveClick 343 350 end 344 object btnDateTime: TButton 351 object btnDateTime: TButton [26] 345 352 Left = 147 346 353 Top = 224 … … 351 358 OnClick = btnDateTimeClick 352 359 end 360 inherited amgrMain: TVA508AccessibilityManager 361 Data = ( 362 ( 363 'Component = lstAllergy' 364 'Status = stsDefault') 365 ( 366 'Component = cboReactionType' 367 'Status = stsDefault') 368 ( 369 'Component = grpObsHist' 370 'Status = stsDefault') 371 ( 372 'Component = memComments' 373 'Status = stsDefault') 374 ( 375 'Component = lstSelectedSymptoms' 376 'Status = stsDefault') 377 ( 378 'Component = ckNoKnownAllergies' 379 'Status = stsDefault') 380 ( 381 'Component = cboOriginator' 382 'Status = stsDefault') 383 ( 384 'Component = cboSymptoms' 385 'Status = stsDefault') 386 ( 387 'Component = btnCurrent' 388 'Status = stsDefault') 389 ( 390 'Component = calObservedDate' 391 'Status = stsDefault') 392 ( 393 'Component = cboSeverity' 394 'Status = stsDefault') 395 ( 396 'Component = btnRemove' 397 'Status = stsDefault') 398 ( 399 'Component = btnDateTime' 400 'Status = stsDefault') 401 ( 402 'Component = memOrder' 403 'Status = stsDefault') 404 ( 405 'Component = cmdAccept' 406 'Status = stsDefault') 407 ( 408 'Component = cmdQuit' 409 'Status = stsDefault') 410 ( 411 'Component = pnlMessage' 412 'Status = stsDefault') 413 ( 414 'Component = memMessage' 415 'Status = stsDefault') 416 ( 417 'Component = frmODAllergy' 418 'Status = stsDefault')) 419 end 353 420 object dlgReactionDateTime: TORDateTimeDlg 354 FMDateTime = 2981202 421 FMDateTime = 2981202.000000000000000000 355 422 DateOnly = False 356 423 RequireTime = False -
cprs/trunk/CPRS-Chart/Orders/fODAllgy.pas
r456 r829 6 6 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 7 7 Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst, 8 Menus, ORDtTm, Buttons ;8 Menus, ORDtTm, Buttons, VA508AccessibilityManager; 9 9 10 10 type … … 321 321 AStringList := TStringList.Create; 322 322 try 323 AStringList.Assign(memComments.Lines);323 FastAssign(memComments.Lines, AStringList); 324 324 LimitStringLength(AStringList, 74); 325 memComments.Lines.Assign(AstringList);325 QuickCopy(AstringList, memComments); 326 326 ControlChange(Self); 327 327 finally -
cprs/trunk/CPRS-Chart/Orders/fODAuto.dfm
r456 r829 14 14 WordWrap = True 15 15 end 16 inherited amgrMain: TVA508AccessibilityManager 17 Data = ( 18 ( 19 'Component = memOrder' 20 'Status = stsDefault') 21 ( 22 'Component = cmdAccept' 23 'Status = stsDefault') 24 ( 25 'Component = cmdQuit' 26 'Status = stsDefault') 27 ( 28 'Component = pnlMessage' 29 'Status = stsDefault') 30 ( 31 'Component = memMessage' 32 'Status = stsDefault') 33 ( 34 'Component = frmODAuto' 35 'Status = stsDefault')) 36 end 16 37 end -
cprs/trunk/CPRS-Chart/Orders/fODAuto.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls; 7 fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls, 8 VA508AccessibilityManager; 8 9 9 10 type -
cprs/trunk/CPRS-Chart/Orders/fODBBank.dfm
r456 r829 1 1 inherited frmODBBank: TfrmODBBank 2 Left = 2723 Top = 1714 Width = 5435 Height = 5072 Left = 409 3 Top = 244 4 HorzScrollBar.Range = 0 5 VertScrollBar.Range = 0 6 6 Caption = 'Blood Component and Diagnostic Test Order Form' 7 ClientHeight = 600 8 ClientWidth = 709 9 ExplicitWidth = 717 10 ExplicitHeight = 634 7 11 PixelsPerInch = 96 8 12 TextHeight = 13 13 object pnlComments: TPanel [0] 14 Left = 12 15 Top = 25 16 Width = 534 17 Height = 368 18 TabOrder = 5 19 Visible = False 20 object lblOrdComment: TLabel 21 Left = 25 22 Top = 3 23 Width = 87 24 Height = 13 25 Caption = 'Order Comment' 26 Font.Charset = DEFAULT_CHARSET 27 Font.Color = clWindowText 28 Font.Height = -11 29 Font.Name = 'MS Sans Serif' 30 Font.Style = [fsBold] 31 ParentFont = False 32 end 33 object btnUpdateComments: TButton 34 Left = 372 35 Top = 174 36 Width = 115 37 Height = 25 38 Caption = 'Update Comments' 39 TabOrder = 0 40 OnClick = btnUpdateCommentsClick 41 end 42 object btnCancelComment: TButton 43 Left = 279 44 Top = 174 45 Width = 75 46 Height = 25 47 Caption = 'Cancel' 48 TabOrder = 1 49 OnClick = btnCancelCommentClick 50 end 51 end 9 52 inherited memOrder: TCaptionMemo 10 Top = 431 11 Width = 423 12 Anchors = [akLeft, akRight, akBottom] 53 Left = 0 54 Top = 399 55 Width = 449 56 Height = 59 57 Visible = False 58 ExplicitLeft = 0 59 ExplicitTop = 399 60 ExplicitWidth = 449 61 ExplicitHeight = 59 13 62 end 14 inherited cmdAccept: TButton 15 Left = 435 16 Top = 427 17 Anchors = [akRight, akBottom] 18 end 19 inherited cmdQuit: TButton 20 Left = 435 21 Top = 454 22 Anchors = [akRight, akBottom] 23 end 24 inherited pnlMessage: TPanel 25 Left = 12 26 Top = 433 27 Width = 389 28 Anchors = [akLeft, akRight, akBottom] 29 end 30 object pnlBB: TPanel 31 Left = 4 32 Top = 4 33 Width = 525 34 Height = 413 35 TabOrder = 5 36 object pnlFull: TPanel 37 Left = 1 38 Top = 1 39 Width = 523 40 Height = 411 41 Align = alClient 42 Caption = 'pnlFull' 43 TabOrder = 0 44 object pgeProduct: TPageControl 63 object pgeProduct: TPageControl [2] 64 Left = 0 65 Top = 0 66 Width = 709 67 Height = 393 68 ActivePage = TabDiag 69 Align = alTop 70 TabOrder = 6 71 TabStop = False 72 OnChange = pgeProductChange 73 object TabInfo: TTabSheet 74 Caption = 'Patient Information' 75 ImageIndex = 3 76 object edtInfo: TCaptionRichEdit 45 77 Left = 0 46 Top = 4 47 Width = 521 48 Height = 411 49 ActivePage = TabDiag 78 Top = 8 79 Width = 556 80 Height = 337 81 TabStop = False 82 BevelInner = bvNone 83 BevelOuter = bvNone 84 Font.Charset = DEFAULT_CHARSET 85 Font.Color = clWindowText 86 Font.Height = -11 87 Font.Name = 'Courier New' 88 Font.Style = [] 89 ParentFont = False 90 ReadOnly = True 91 ScrollBars = ssBoth 92 TabOrder = 0 93 Caption = 'Patient Info' 94 end 95 end 96 object TabDiag: TTabSheet 97 Caption = 'Blood Bank Orders' 98 ImageIndex = 2 99 object lblReqComment: TOROffsetLabel 100 Left = 298 101 Top = 25 102 Width = 108 103 Height = 37 104 HorzOffset = 2 105 Transparent = False 106 VertOffset = 2 107 WordWrap = False 108 end 109 object pnlFields: TPanel 110 Left = 0 111 Top = 163 112 Width = 701 113 Height = 99 114 Hint = 'Data entered into these fields apply to the entire order.' 115 Align = alTop 116 BevelEdges = [] 117 BevelOuter = bvNone 118 ParentShowHint = False 119 ShowHint = True 120 TabOrder = 2 121 object lblDiagComment: TOROffsetLabel 122 Left = 257 123 Top = 35 124 Width = 46 125 Height = 15 126 Caption = 'Comment' 127 Font.Charset = DEFAULT_CHARSET 128 Font.Color = clWindowText 129 Font.Height = -11 130 Font.Name = 'MS Sans Serif' 131 Font.Style = [] 132 HorzOffset = 2 133 ParentFont = False 134 Transparent = False 135 VertOffset = 2 136 WordWrap = True 137 end 138 object lblUrgency: TLabel 139 Left = 8 140 Top = -2 141 Width = 44 142 Height = 13 143 Caption = 'Urgency*' 144 Font.Charset = DEFAULT_CHARSET 145 Font.Color = clWindowText 146 Font.Height = -11 147 Font.Name = 'MS Sans Serif' 148 Font.Style = [] 149 ParentFont = False 150 end 151 object lblReason: TLabel 152 Left = 10 153 Top = 35 154 Width = 99 155 Height = 13 156 Caption = 'Reason for Request*' 157 Font.Charset = DEFAULT_CHARSET 158 Font.Color = clWindowText 159 Font.Height = -11 160 Font.Name = 'MS Sans Serif' 161 Font.Style = [] 162 ParentFont = False 163 end 164 object lblSurgery: TLabel 165 Left = 115 166 Top = -2 167 Width = 36 168 Height = 13 169 Hint = 170 'Enter the name of the surgical procedure that this request is fo' + 171 'r.' 172 Caption = 'Surgery' 173 Font.Charset = DEFAULT_CHARSET 174 Font.Color = clWindowText 175 Font.Height = -11 176 Font.Name = 'MS Sans Serif' 177 Font.Style = [] 178 ParentFont = False 179 end 180 object lblRequiredField: TLabel 181 Left = 10 182 Top = 75 183 Width = 122 184 Height = 13 185 Caption = '* Indicates a required field' 186 end 187 object cboUrgency: TORComboBox 188 Left = 12 189 Top = 12 190 Width = 98 191 Height = 21 192 Style = orcsDropDown 193 AutoSelect = True 194 Caption = 'Urgency' 195 Color = clWindow 196 DropDownCount = 8 197 Font.Charset = DEFAULT_CHARSET 198 Font.Color = clWindowText 199 Font.Height = -11 200 Font.Name = 'MS Sans Serif' 201 Font.Style = [] 202 ItemHeight = 13 203 ItemTipColor = clWindow 204 ItemTipEnable = True 205 ListItemsOnly = True 206 LongList = False 207 LookupPiece = 0 208 MaxLength = 0 209 ParentFont = False 210 Pieces = '2' 211 Sorted = False 212 SynonymChars = '<>' 213 TabOrder = 0 214 OnChange = cboUrgencyChange 215 OnExit = cboUrgencyExit 216 CharsNeedMatch = 1 217 end 218 object chkConsent: TCheckBox 219 Left = 351 220 Top = 10 221 Width = 112 222 Height = 17 223 Hint = 'Informed Consent Signed On Chart?' 224 Alignment = taLeftJustify 225 Caption = 'Informed Consent?' 226 Font.Charset = DEFAULT_CHARSET 227 Font.Color = clWindowText 228 Font.Height = -11 229 Font.Name = 'MS Sans Serif' 230 Font.Style = [] 231 ParentFont = False 232 ParentShowHint = False 233 ShowHint = True 234 TabOrder = 3 235 Visible = False 236 OnClick = chkConsentClick 237 end 238 object cboSurgery: TORComboBox 239 Left = 115 240 Top = 12 241 Width = 218 242 Height = 21 243 Style = orcsDropDown 244 AutoSelect = True 245 Caption = 'Surgery' 246 Color = clWindow 247 DropDownCount = 8 248 Enabled = False 249 Font.Charset = DEFAULT_CHARSET 250 Font.Color = clWindowText 251 Font.Height = -11 252 Font.Name = 'MS Sans Serif' 253 Font.Style = [] 254 ItemHeight = 13 255 ItemTipColor = clWindow 256 ItemTipEnable = True 257 ListItemsOnly = False 258 LongList = False 259 LookupPiece = 0 260 MaxLength = 0 261 ParentFont = False 262 Pieces = '2' 263 Sorted = False 264 SynonymChars = '<>' 265 TabOrder = 1 266 OnChange = cboSurgeryChange 267 OnClick = cboSurgeryClick 268 CharsNeedMatch = 1 269 end 270 object cboReasons: TORComboBox 271 Left = 12 272 Top = 51 273 Width = 239 274 Height = 21 275 Style = orcsDropDown 276 AutoSelect = True 277 Color = clWindow 278 DropDownCount = 8 279 ItemHeight = 13 280 ItemTipColor = clWindow 281 ItemTipEnable = True 282 ListItemsOnly = False 283 LongList = False 284 LookupPiece = 0 285 MaxLength = 0 286 Sorted = False 287 SynonymChars = '<>' 288 TabOrder = 2 289 OnChange = cboReasonsChange 290 OnEnter = cboReasonsEnter 291 OnExit = cboReasonsExit 292 CharsNeedMatch = 1 293 end 294 object memDiagComment: TRichEdit 295 Left = 257 296 Top = 51 297 Width = 250 298 Height = 48 299 TabOrder = 4 300 OnChange = memDiagCommentChange 301 end 302 end 303 object pnlSelect: TPanel 304 Left = 0 305 Top = 35 306 Width = 701 307 Height = 128 308 Align = alTop 309 BevelEdges = [] 310 BevelOuter = bvNone 311 TabOrder = 1 312 object lblTNS: TLabel 313 Left = 298 314 Top = 109 315 Width = 14 316 Height = 13 317 Caption = 'tns' 318 Color = clActiveBorder 319 Font.Charset = DEFAULT_CHARSET 320 Font.Color = clMaroon 321 Font.Height = -11 322 Font.Name = 'MS Sans Serif' 323 Font.Style = [] 324 ParentColor = False 325 ParentFont = False 326 Visible = False 327 end 328 object pnlDiagnosticTests: TGroupBox 329 Left = 256 330 Top = 0 331 Width = 267 332 Height = 110 333 Caption = 'Diagnostic Tests' 334 Font.Charset = DEFAULT_CHARSET 335 Font.Color = clWindowText 336 Font.Height = -11 337 Font.Name = 'MS Sans Serif' 338 Font.Style = [fsBold] 339 ParentFont = False 340 TabOrder = 1 341 object lblCollType: TLabel 342 Left = 13 343 Top = 33 344 Width = 77 345 Height = 13 346 Caption = 'Collection Type*' 347 Font.Charset = DEFAULT_CHARSET 348 Font.Color = clWindowText 349 Font.Height = -11 350 Font.Name = 'MS Sans Serif' 351 Font.Style = [] 352 ParentFont = False 353 end 354 object lblCollTime: TLabel 355 Left = 12 356 Top = 70 357 Width = 104 358 Height = 13 359 Caption = 'Collection Date/Time*' 360 Font.Charset = DEFAULT_CHARSET 361 Font.Color = clWindowText 362 Font.Height = -11 363 Font.Name = 'MS Sans Serif' 364 Font.Style = [] 365 ParentFont = False 366 end 367 object cmdImmedColl: TSpeedButton 368 Left = 148 369 Top = 89 370 Width = 21 371 Height = 11 372 Font.Charset = DEFAULT_CHARSET 373 Font.Color = clWindowText 374 Font.Height = -16 375 Font.Name = 'MS Sans Serif' 376 Font.Style = [fsBold] 377 Glyph.Data = { 378 D6000000424DD60000000000000076000000280000000C0000000C0000000100 379 0400000000006000000000000000000000001000000010000000000000000000 380 80000080000000808000800000008000800080800000C0C0C000808080000000 381 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 382 0000333333333333000033333333333300003333333333330000300330033003 383 0000300330033003000033333333333300003333333333330000333333333333 384 0000333333333333000033333333333300003333333333330000} 385 ParentFont = False 386 ParentShowHint = False 387 ShowHint = False 388 OnClick = cmdImmedCollClick 389 end 390 object pnlCollTimeButton: TKeyClickPanel 391 Left = 85 392 Top = 89 393 Width = 20 394 Height = 13 395 BevelOuter = bvNone 396 Caption = 'Select collection time' 397 TabOrder = 5 398 TabStop = True 399 end 400 object cboAvailTest: TORComboBox 401 Left = 13 402 Top = 13 403 Width = 234 404 Height = 21 405 Style = orcsDropDown 406 AutoSelect = True 407 Caption = 'Diagnostic Tests' 408 Color = clWindow 409 DropDownCount = 8 410 Font.Charset = DEFAULT_CHARSET 411 Font.Color = clWindowText 412 Font.Height = -11 413 Font.Name = 'MS Sans Serif' 414 Font.Style = [] 415 ItemHeight = 13 416 ItemTipColor = clWindow 417 ItemTipEnable = True 418 ListItemsOnly = False 419 LongList = True 420 LookupPiece = 0 421 MaxLength = 0 422 ParentFont = False 423 Pieces = '2' 424 Sorted = False 425 SynonymChars = '<>' 426 TabOrder = 0 427 TabStop = True 428 OnExit = cboAvailTestExit 429 OnMouseClick = cboAvailTestSelect 430 OnNeedData = cboAvailTestNeedData 431 CharsNeedMatch = 1 432 end 433 object cboCollType: TORComboBox 434 Left = 12 435 Top = 46 436 Width = 165 437 Height = 21 438 Style = orcsDropDown 439 AutoSelect = True 440 Caption = 'Collection Type' 441 Color = clWindow 442 DropDownCount = 8 443 Font.Charset = DEFAULT_CHARSET 444 Font.Color = clWindowText 445 Font.Height = -11 446 Font.Name = 'MS Sans Serif' 447 Font.Style = [] 448 ItemHeight = 13 449 ItemTipColor = clWindow 450 ItemTipEnable = True 451 ListItemsOnly = True 452 LongList = False 453 LookupPiece = 0 454 MaxLength = 0 455 ParentFont = False 456 Pieces = '2' 457 Sorted = False 458 SynonymChars = '<>' 459 TabOrder = 1 460 OnChange = cboCollTypeChange 461 CharsNeedMatch = 1 462 end 463 object cboCollTime: TORComboBox 464 Left = 12 465 Top = 82 466 Width = 165 467 Height = 21 468 Style = orcsDropDown 469 AutoSelect = True 470 Caption = 'Collection Date/Time' 471 Color = clWindow 472 DropDownCount = 8 473 Font.Charset = DEFAULT_CHARSET 474 Font.Color = clWindowText 475 Font.Height = -11 476 Font.Name = 'MS Sans Serif' 477 Font.Style = [] 478 ItemHeight = 13 479 ItemTipColor = clWindow 480 ItemTipEnable = True 481 ListItemsOnly = False 482 LongList = False 483 LookupPiece = 0 484 MaxLength = 0 485 ParentFont = False 486 Pieces = '2' 487 Sorted = False 488 SynonymChars = '<>' 489 TabOrder = 2 490 OnChange = cboCollTimeChange 491 CharsNeedMatch = 1 492 end 493 object calCollTime: TORDateBox 494 Left = 12 495 Top = 82 496 Width = 165 497 Height = 21 498 Font.Charset = DEFAULT_CHARSET 499 Font.Color = clWindowText 500 Font.Height = -11 501 Font.Name = 'MS Sans Serif' 502 Font.Style = [] 503 ParentFont = False 504 TabOrder = 3 505 OnChange = calCollTimeChange 506 DateOnly = False 507 RequireTime = False 508 end 509 object txtImmedColl: TCaptionEdit 510 Left = 12 511 Top = 82 512 Width = 165 513 Height = 21 514 Color = clBtnFace 515 ReadOnly = True 516 TabOrder = 4 517 Text = 'txtImmedColl' 518 end 519 end 520 object pnlBloodComponents: TGroupBox 521 Left = 4 522 Top = 0 523 Width = 246 524 Height = 110 525 Caption = 'Blood Components' 526 Font.Charset = DEFAULT_CHARSET 527 Font.Color = clWindowText 528 Font.Height = -11 529 Font.Name = 'MS Sans Serif' 530 Font.Style = [fsBold] 531 ParentFont = False 532 TabOrder = 0 533 object lblQuantity: TLabel 534 Left = 198 535 Top = 0 536 Width = 43 537 Height = 13 538 Caption = 'Quantity*' 539 Font.Charset = DEFAULT_CHARSET 540 Font.Color = clWindowText 541 Font.Height = -11 542 Font.Name = 'MS Sans Serif' 543 Font.Style = [] 544 ParentFont = False 545 end 546 object lblModifiers: TLabel 547 Left = 7 548 Top = 33 549 Width = 42 550 Height = 13 551 Caption = 'Modifiers' 552 Font.Charset = DEFAULT_CHARSET 553 Font.Color = clWindowText 554 Font.Height = -11 555 Font.Name = 'MS Sans Serif' 556 Font.Style = [] 557 ParentFont = False 558 end 559 object lblWanted: TLabel 560 Left = 7 561 Top = 70 562 Width = 96 563 Height = 13 564 Caption = 'Date/Time Wanted*' 565 Font.Charset = DEFAULT_CHARSET 566 Font.Color = clWindowText 567 Font.Height = -11 568 Font.Name = 'MS Sans Serif' 569 Font.Style = [] 570 ParentFont = False 571 end 572 object cboAvailComp: TORComboBox 573 Left = 11 574 Top = 13 575 Width = 181 576 Height = 21 577 Style = orcsDropDown 578 AutoSelect = True 579 Caption = 'Blood Components' 580 Color = clWindow 581 DropDownCount = 8 582 Font.Charset = DEFAULT_CHARSET 583 Font.Color = clWindowText 584 Font.Height = -11 585 Font.Name = 'MS Sans Serif' 586 Font.Style = [] 587 ItemHeight = 13 588 ItemTipColor = clWindow 589 ItemTipEnable = True 590 ListItemsOnly = False 591 LongList = False 592 LookupPiece = 0 593 MaxLength = 0 594 ParentFont = False 595 Pieces = '2' 596 Sorted = False 597 SynonymChars = '<>' 598 TabOrder = 0 599 TabStop = True 600 OnChange = cboAvailCompChange 601 OnExit = cboAvailCompExit 602 OnMouseClick = cboAvailCompSelect 603 OnNeedData = cboAvailCompNeedData 604 CharsNeedMatch = 1 605 end 606 object tQuantity: TEdit 607 Left = 198 608 Top = 13 609 Width = 25 610 Height = 21 611 Font.Charset = DEFAULT_CHARSET 612 Font.Color = clWindowText 613 Font.Height = -11 614 Font.Name = 'MS Sans Serif' 615 Font.Style = [] 616 ParentFont = False 617 TabOrder = 1 618 OnChange = tQuantityChange 619 OnClick = tQuantityClick 620 OnEnter = tQuantityEnter 621 end 622 object cboModifiers: TORComboBox 623 Left = 11 624 Top = 46 625 Width = 133 626 Height = 21 627 Style = orcsDropDown 628 AutoSelect = True 629 Caption = 'Modifier' 630 Color = clWindow 631 DropDownCount = 8 632 Font.Charset = DEFAULT_CHARSET 633 Font.Color = clWindowText 634 Font.Height = -11 635 Font.Name = 'MS Sans Serif' 636 Font.Style = [] 637 ItemHeight = 13 638 ItemTipColor = clWindow 639 ItemTipEnable = True 640 ListItemsOnly = True 641 LongList = False 642 LookupPiece = 0 643 MaxLength = 0 644 ParentFont = False 645 Sorted = False 646 SynonymChars = '<>' 647 TabOrder = 2 648 OnChange = cboModifiersChange 649 CharsNeedMatch = 1 650 end 651 object calWantTime: TORDateBox 652 Left = 11 653 Top = 82 654 Width = 149 655 Height = 21 656 Font.Charset = DEFAULT_CHARSET 657 Font.Color = clWindowText 658 Font.Height = -11 659 Font.Name = 'MS Sans Serif' 660 Font.Style = [] 661 ParentFont = False 662 TabOrder = 3 663 OnChange = calWantTimeChange 664 DateOnly = False 665 RequireTime = False 666 end 667 end 668 end 669 object GroupBox1: TGroupBox 670 Left = 0 671 Top = 0 672 Width = 701 673 Height = 35 674 Align = alTop 675 Caption = ' Personal Quick Orders' 50 676 Font.Charset = DEFAULT_CHARSET 51 677 Font.Color = clWindowText … … 53 679 Font.Name = 'MS Sans Serif' 54 680 Font.Style = [] 55 Images = ImageList156 681 ParentFont = False 57 TabIndex = 158 682 TabOrder = 0 59 OnChange = pgeProductChange 60 object tabInfo: TTabSheet 61 Caption = 'Patient Information' 62 ImageIndex = 3 63 object edtInfo: TCaptionRichEdit 64 Left = 0 65 Top = 8 66 Width = 513 67 Height = 369 68 Font.Charset = DEFAULT_CHARSET 69 Font.Color = clWindowText 70 Font.Height = -11 71 Font.Name = 'Courier New' 72 Font.Style = [] 73 ParentFont = False 74 ReadOnly = True 75 ScrollBars = ssBoth 76 TabOrder = 0 77 Caption = 'Patient Info' 78 end 79 end 80 object TabDiag: TTabSheet 81 Caption = 'Orders' 82 ImageIndex = 2 83 object lblReqComment: TOROffsetLabel 84 Left = 300 85 Top = 25 86 Width = 104 87 Height = 33 88 HorzOffset = 2 89 Transparent = False 90 VertOffset = 2 91 WordWrap = False 92 end 93 object pnlFields: TPanel 94 Left = 0 95 Top = 87 96 Width = 513 97 Height = 162 98 Hint = 'Data entered into these fields apply to the entire order.' 99 ParentShowHint = False 100 ShowHint = True 101 TabOrder = 0 102 object lblDiagComment: TOROffsetLabel 103 Left = 8 104 Top = 114 105 Width = 46 106 Height = 15 107 Caption = 'Comment' 108 HorzOffset = 2 109 Transparent = False 110 VertOffset = 2 111 WordWrap = True 112 end 113 object lblUrgency: TLabel 114 Left = 8 115 Top = 80 116 Width = 40 117 Height = 13 118 Caption = 'Urgency' 119 end 120 object lblCollType: TLabel 121 Left = 8 122 Top = 41 123 Width = 73 124 Height = 13 125 Caption = 'Collection Type' 126 end 127 object lblPreparation: TLabel 128 Left = 352 129 Top = 41 130 Width = 54 131 Height = 13 132 Caption = 'Preparation' 133 Enabled = False 134 Visible = False 135 end 136 object lblWanted: TLabel 137 Left = 352 138 Top = 5 139 Width = 90 140 Height = 13 141 Caption = 'Date Time Wanted' 142 end 143 object lblReason: TLabel 144 Left = 332 145 Top = 114 146 Width = 95 147 Height = 13 148 Caption = 'Reason for Request' 149 end 150 object lblSurgery: TLabel 151 Left = 352 152 Top = 80 153 Width = 36 154 Height = 13 155 Hint = 156 'Enter the name of the surgical procedure that this request is fo' + 157 'r.' 158 Caption = 'Surgery' 159 end 160 object lblCollTime: TLabel 161 Left = 8 162 Top = 5 163 Width = 100 164 Height = 13 165 Caption = 'Collection Date/Time' 166 end 167 object cmdImmedColl: TSpeedButton 168 Left = 132 169 Top = 21 170 Width = 24 171 Height = 17 172 Font.Charset = DEFAULT_CHARSET 173 Font.Color = clWindowText 174 Font.Height = -16 175 Font.Name = 'MS Sans Serif' 176 Font.Style = [fsBold] 177 Glyph.Data = { 178 D6000000424DD60000000000000076000000280000000C0000000C0000000100 179 0400000000006000000000000000000000001000000010000000000000000000 180 80000080000000808000800000008000800080800000C0C0C000808080000000 181 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 182 0000333333333333000033333333333300003333333333330000300330033003 183 0000300330033003000033333333333300003333333333330000333333333333 184 0000333333333333000033333333333300003333333333330000} 185 ParentFont = False 186 ParentShowHint = False 187 ShowHint = False 188 OnClick = cmdImmedCollClick 189 end 190 object txtDiagComment: TCaptionEdit 191 Left = 8 192 Top = 132 193 Width = 293 194 Height = 21 195 MaxLength = 240 196 TabOrder = 6 197 OnChange = txtDiagCommentChange 198 end 199 object cboUrgency: TORComboBox 200 Left = 8 201 Top = 96 202 Width = 112 203 Height = 21 204 Style = orcsDropDown 205 AutoSelect = True 206 Caption = 'Urgency' 207 Color = clWindow 208 DropDownCount = 8 209 ItemHeight = 13 210 ItemTipColor = clWindow 211 ItemTipEnable = True 212 ListItemsOnly = True 213 LongList = False 214 LookupPiece = 0 215 MaxLength = 0 216 Pieces = '2' 217 Sorted = False 218 SynonymChars = '<>' 219 TabOrder = 5 220 OnChange = cboUrgencyChange 221 CharsNeedMatch = 1 222 end 223 object cboCollType: TORComboBox 224 Left = 8 225 Top = 57 226 Width = 149 227 Height = 21 228 Style = orcsDropDown 229 AutoSelect = True 230 Caption = 'Collection Type' 231 Color = clWindow 232 DropDownCount = 8 233 ItemHeight = 13 234 ItemTipColor = clWindow 235 ItemTipEnable = True 236 ListItemsOnly = True 237 LongList = False 238 LookupPiece = 0 239 MaxLength = 0 240 Pieces = '2' 241 Sorted = False 242 SynonymChars = '<>' 243 TabOrder = 4 244 OnChange = cboCollTypeChange 245 CharsNeedMatch = 1 246 end 247 object chkConsent: TCheckBox 248 Left = 192 249 Top = 21 250 Width = 112 251 Height = 17 252 Hint = 'Informed Consent Signed On Chart?' 253 Alignment = taLeftJustify 254 Caption = 'Informed Consent?' 255 ParentShowHint = False 256 ShowHint = True 257 TabOrder = 11 258 OnClick = chkConsentClick 259 end 260 object calWantTime: TORDateBox 261 Left = 352 262 Top = 17 263 Width = 149 264 Height = 21 265 TabOrder = 7 266 OnChange = calWantTimeChange 267 DateOnly = False 268 RequireTime = False 269 end 270 object tReason: TEdit 271 Left = 332 272 Top = 132 273 Width = 169 274 Height = 21 275 MaxLength = 80 276 TabOrder = 10 277 OnChange = tReasonChange 278 end 279 object cboSurgery: TORComboBox 280 Left = 352 281 Top = 92 282 Width = 149 283 Height = 21 284 Style = orcsDropDown 285 AutoSelect = True 286 Caption = 'Surgery' 287 Color = clWindow 288 DropDownCount = 8 289 ItemHeight = 13 290 ItemTipColor = clWindow 291 ItemTipEnable = True 292 ListItemsOnly = False 293 LongList = False 294 LookupPiece = 0 295 MaxLength = 0 296 Pieces = '2' 297 Sorted = False 298 SynonymChars = '<>' 299 TabOrder = 9 300 OnChange = cboSurgeryChange 301 CharsNeedMatch = 1 302 end 303 object txtImmedColl: TCaptionEdit 304 Left = 12 305 Top = 17 306 Width = 145 307 Height = 21 308 Color = clBtnFace 309 ReadOnly = True 310 TabOrder = 2 311 Text = 'txtImmedColl' 312 end 313 object cboCollTime: TORComboBox 314 Left = 8 315 Top = 17 316 Width = 149 317 Height = 21 318 Style = orcsDropDown 319 AutoSelect = True 320 Caption = 'Collection Date/Time' 321 Color = clWindow 322 DropDownCount = 8 323 ItemHeight = 13 324 ItemTipColor = clWindow 325 ItemTipEnable = True 326 ListItemsOnly = False 327 LongList = False 328 LookupPiece = 0 329 MaxLength = 0 330 Pieces = '2' 331 Sorted = False 332 SynonymChars = '<>' 333 TabOrder = 0 334 CharsNeedMatch = 1 335 end 336 object pnlCollTimeButton: TKeyClickPanel 337 Left = 137 338 Top = 19 339 Width = 20 340 Height = 19 341 BevelOuter = bvNone 342 Caption = 'Select collection time' 343 TabOrder = 3 344 TabStop = True 345 end 346 object calCollTime: TORDateBox 347 Left = 8 348 Top = 17 349 Width = 149 350 Height = 21 351 TabOrder = 1 352 OnChange = calCollTimeChange 353 DateOnly = False 354 RequireTime = False 355 end 356 object cboPreparation: TORComboBox 357 Left = 352 358 Top = 56 359 Width = 149 360 Height = 21 361 Style = orcsDropDown 362 AutoSelect = True 363 Color = clWindow 364 DropDownCount = 8 365 Enabled = False 366 Items.Strings = ( 367 'I^Immediate' 368 'H^Hold') 369 ItemHeight = 13 370 ItemTipColor = clWindow 371 ItemTipEnable = True 372 ListItemsOnly = False 373 LongList = False 374 LookupPiece = 0 375 MaxLength = 0 376 Pieces = '2' 377 Sorted = False 378 SynonymChars = '<>' 379 TabOrder = 8 380 Visible = False 381 OnChange = cboPreparationChange 382 CharsNeedMatch = 1 383 end 384 end 385 object pnlTop: TPanel 386 Left = 0 387 Top = 1 388 Width = 513 389 Height = 84 390 TabOrder = 1 391 object pnlSelect: TPanel 392 Left = 5 393 Top = 1 394 Width = 511 395 Height = 76 396 TabOrder = 0 397 object pnlDiagTests: TGroupBox 398 Left = 8 399 Top = 0 400 Width = 245 401 Height = 73 402 Caption = 'Diagnostic Tests' 403 Font.Charset = DEFAULT_CHARSET 404 Font.Color = clWindowText 405 Font.Height = -11 406 Font.Name = 'MS Sans Serif' 407 Font.Style = [] 408 ParentFont = False 409 TabOrder = 0 410 object lblTNS: TLabel 411 Left = 8 412 Top = 52 413 Width = 3 414 Height = 13 415 Color = clActiveBorder 416 Font.Charset = DEFAULT_CHARSET 417 Font.Color = clMaroon 418 Font.Height = -11 419 Font.Name = 'MS Sans Serif' 420 Font.Style = [] 421 ParentColor = False 422 ParentFont = False 423 end 424 object cboAvailTest: TORComboBox 425 Left = 7 426 Top = 18 427 Width = 226 428 Height = 21 429 Style = orcsDropDown 430 AutoSelect = True 431 Caption = 'Available Lab Tests' 432 Color = clWindow 433 DropDownCount = 8 434 ItemHeight = 13 435 ItemTipColor = clWindow 436 ItemTipEnable = True 437 ListItemsOnly = True 438 LongList = True 439 LookupPiece = 0 440 MaxLength = 0 441 Pieces = '2' 442 Sorted = False 443 SynonymChars = '<>' 444 TabOrder = 0 445 OnClick = cboAvailTestSelect 446 OnExit = cboAvailTestExit 447 OnNeedData = cboAvailTestNeedData 448 CharsNeedMatch = 1 449 end 450 end 451 object pnlBloodComponents: TGroupBox 452 Left = 252 453 Top = 0 454 Width = 253 455 Height = 73 456 Caption = 'Blood Components' 457 TabOrder = 1 458 object lblQuantity: TLabel 459 Left = 198 460 Top = 0 461 Width = 39 462 Height = 13 463 Caption = 'Quantity' 464 end 465 object lblModifiers: TLabel 466 Left = 10 467 Top = 48 468 Width = 42 469 Height = 13 470 Caption = 'Modifiers' 471 end 472 object cboAvailComp: TORComboBox 473 Left = 8 474 Top = 18 475 Width = 181 476 Height = 21 477 Style = orcsDropDown 478 AutoSelect = True 479 Caption = 'Available Lab Tests' 480 Color = clWindow 481 DropDownCount = 8 482 ItemHeight = 13 483 ItemTipColor = clWindow 484 ItemTipEnable = True 485 ListItemsOnly = True 486 LongList = True 487 LookupPiece = 0 488 MaxLength = 0 489 Pieces = '2' 490 Sorted = False 491 SynonymChars = '<>' 492 TabOrder = 0 493 OnClick = cboAvailCompSelect 494 OnExit = cboAvailCompExit 495 OnNeedData = cboAvailCompNeedData 496 CharsNeedMatch = 1 497 end 498 object tQuantity: TEdit 499 Left = 200 500 Top = 16 501 Width = 25 502 Height = 21 503 TabOrder = 1 504 Text = '0' 505 end 506 object upQuantity: TUpDown 507 Left = 225 508 Top = 16 509 Width = 15 510 Height = 21 511 Associate = tQuantity 512 Min = 0 513 Position = 0 514 TabOrder = 2 515 Wrap = False 516 end 517 object cboModifiers: TORComboBox 518 Left = 56 519 Top = 44 520 Width = 133 521 Height = 21 522 Style = orcsDropDown 523 AutoSelect = True 524 Caption = 'Modifier' 525 Color = clWindow 526 DropDownCount = 8 527 ItemHeight = 13 528 ItemTipColor = clWindow 529 ItemTipEnable = True 530 ListItemsOnly = True 531 LongList = False 532 LookupPiece = 0 533 MaxLength = 0 534 Sorted = False 535 SynonymChars = '<>' 536 TabOrder = 3 537 CharsNeedMatch = 1 538 end 539 end 540 end 541 end 542 end 543 object TabResults: TTabSheet 544 Caption = 'Lab Results' 545 Enabled = False 546 object edtResults: TCaptionRichEdit 547 Left = 0 548 Top = 8 549 Width = 513 550 Height = 369 551 Font.Charset = DEFAULT_CHARSET 552 Font.Color = clWindowText 553 Font.Height = -11 554 Font.Name = 'Courier New' 555 Font.Style = [] 556 ParentFont = False 557 TabOrder = 0 558 end 683 object cboQuick: TORComboBox 684 Left = 15 685 Top = 11 686 Width = 488 687 Height = 21 688 Style = orcsDropDown 689 AutoSelect = True 690 Color = clWindow 691 DropDownCount = 8 692 ItemHeight = 13 693 ItemTipColor = clWindow 694 ItemTipEnable = True 695 ListItemsOnly = False 696 LongList = True 697 LookupPiece = 0 698 MaxLength = 0 699 Pieces = '2' 700 Sorted = False 701 SynonymChars = '<>' 702 TabOrder = 0 703 OnClick = cboQuickClick 704 CharsNeedMatch = 1 559 705 end 560 706 end 561 707 object pnlSelectedTests: TGroupBox 562 Left = 4 563 Top = 292 564 Width = 518 565 Height = 117 708 Left = 0 709 Top = 262 710 Width = 701 711 Height = 112 712 Align = alTop 566 713 Caption = 'Selected Components and Tests' 567 TabOrder = 1 714 Font.Charset = DEFAULT_CHARSET 715 Font.Color = clWindowText 716 Font.Height = -11 717 Font.Name = 'MS Sans Serif' 718 Font.Style = [fsBold] 719 ParentFont = False 720 TabOrder = 3 568 721 Visible = False 569 object btnAddTests: TORAlignSpeedButton570 Left = 426571 Top = 17572 Width = 75573 Height = 21574 Caption = 'Add'575 Font.Charset = DEFAULT_CHARSET576 Font.Color = clWindowText577 Font.Height = -11578 Font.Name = 'MS Sans Serif'579 Font.Style = []580 Glyph.Data = {581 F6000000424DF600000000000000760000002800000010000000100000000100582 0400000000008000000000000000000000001000000000000000000000000000583 8000008000000080800080000000800080008080000080808000C0C0C0000000584 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333585 3333333333333333333333333333333333333333333003333333333333300333586 3333333333300333333333333330033333333330000000000333333000000000587 0333333333300333333333333330033333333333333003333333333333300333588 3333333333333333333333333333333333333333333333333333}589 ParentFont = False590 OnClick = btnAddTestsClick591 end592 722 object lvSelectionList: TCaptionListView 593 Left = 4 594 Top = 16 595 Width = 409 596 Height = 93 723 Left = 5 724 Top = 12 725 Width = 417 726 Height = 91 727 Color = clBtnFace 597 728 Columns = < 598 729 item … … 609 740 end 610 741 item 611 Caption = 'ID' 742 Caption = 'ModifierItemIndex' 743 Width = 0 744 end 745 item 746 Caption = 'TestIEN' 612 747 Width = 0 613 748 end> 749 Font.Charset = DEFAULT_CHARSET 750 Font.Color = clWindowText 751 Font.Height = -11 752 Font.Name = 'MS Sans Serif' 753 Font.Style = [fsBold] 754 ReadOnly = True 614 755 RowSelect = True 756 ParentFont = False 615 757 TabOrder = 0 758 TabStop = False 616 759 ViewStyle = vsReport 760 OnClick = lvSelectionListClick 617 761 Caption = 'lvSelectionList' 618 762 end 619 763 object btnRemove: TButton 620 Left = 42 6621 Top = 42764 Left = 428 765 Top = 37 622 766 Width = 75 623 767 Height = 21 624 768 Caption = 'Remove' 769 Font.Charset = DEFAULT_CHARSET 770 Font.Color = clWindowText 771 Font.Height = -11 772 Font.Name = 'MS Sans Serif' 773 Font.Style = [] 774 ParentFont = False 625 775 TabOrder = 1 626 776 OnClick = btnRemoveClick 627 777 end 628 778 object btnRemoveAll: TButton 629 Left = 42 6630 Top = 6 8779 Left = 428 780 Top = 64 631 781 Width = 75 632 782 Height = 21 633 783 Caption = 'Remove All' 784 Font.Charset = DEFAULT_CHARSET 785 Font.Color = clWindowText 786 Font.Height = -11 787 Font.Name = 'MS Sans Serif' 788 Font.Style = [] 789 ParentFont = False 634 790 TabOrder = 2 635 791 OnClick = btnRemoveAllClick 636 792 end 793 end 794 end 795 object TabResults: TTabSheet 796 Caption = 'Lab Results' 797 object edtResults: TCaptionRichEdit 798 Left = -4 799 Top = 57 800 Width = 517 801 Height = 290 802 Font.Charset = DEFAULT_CHARSET 803 Font.Color = clWindowText 804 Font.Height = -11 805 Font.Name = 'Courier New' 806 Font.Style = [] 807 ParentFont = False 808 TabOrder = 0 637 809 end 638 810 end 639 811 end 812 inherited cmdAccept: TButton 813 Left = 455 814 Top = 399 815 TabOrder = 2 816 Visible = False 817 ExplicitLeft = 455 818 ExplicitTop = 399 819 end 820 inherited cmdQuit: TButton 821 Left = 455 822 Top = 426 823 Width = 52 824 TabOrder = 3 825 ExplicitLeft = 455 826 ExplicitTop = 426 827 ExplicitWidth = 52 828 end 829 inherited pnlMessage: TPanel 830 Left = 8 831 Top = 409 832 Width = 409 833 Height = 49 834 TabOrder = 1 835 ExplicitLeft = 8 836 ExplicitTop = 409 837 ExplicitWidth = 409 838 ExplicitHeight = 49 839 inherited memMessage: TRichEdit 840 Left = 42 841 Top = 5 842 Width = 360 843 ExplicitLeft = 42 844 ExplicitTop = 5 845 ExplicitWidth = 360 846 end 847 end 848 inherited amgrMain: TVA508AccessibilityManager 849 Data = ( 850 ( 851 'Component = memOrder' 852 'Status = stsDefault') 853 ( 854 'Component = cmdAccept' 855 'Status = stsDefault') 856 ( 857 'Component = cmdQuit' 858 'Status = stsDefault') 859 ( 860 'Component = pnlMessage' 861 'Status = stsDefault') 862 ( 863 'Component = memMessage' 864 'Status = stsDefault') 865 ( 866 'Component = frmODBBank' 867 'Status = stsDefault') 868 ( 869 'Component = pnlComments' 870 'Status = stsDefault') 871 ( 872 'Component = btnUpdateComments' 873 'Status = stsDefault') 874 ( 875 'Component = btnCancelComment' 876 'Status = stsDefault') 877 ( 878 'Component = pgeProduct' 879 'Status = stsDefault') 880 ( 881 'Component = TabInfo' 882 'Status = stsDefault') 883 ( 884 'Component = edtInfo' 885 'Status = stsDefault') 886 ( 887 'Component = TabDiag' 888 'Status = stsDefault') 889 ( 890 'Component = TabResults' 891 'Status = stsDefault') 892 ( 893 'Component = edtResults' 894 'Status = stsDefault') 895 ( 896 'Component = pnlFields' 897 'Status = stsDefault') 898 ( 899 'Component = cboUrgency' 900 'Status = stsDefault') 901 ( 902 'Component = chkConsent' 903 'Status = stsDefault') 904 ( 905 'Component = cboSurgery' 906 'Status = stsDefault') 907 ( 908 'Component = pnlSelect' 909 'Status = stsDefault') 910 ( 911 'Component = pnlDiagnosticTests' 912 'Status = stsDefault') 913 ( 914 'Component = cboAvailTest' 915 'Status = stsDefault') 916 ( 917 'Component = pnlBloodComponents' 918 'Status = stsDefault') 919 ( 920 'Component = cboAvailComp' 921 'Status = stsDefault') 922 ( 923 'Component = tQuantity' 924 'Status = stsDefault') 925 ( 926 'Component = cboModifiers' 927 'Status = stsDefault') 928 ( 929 'Component = GroupBox1' 930 'Status = stsDefault') 931 ( 932 'Component = cboQuick' 933 'Status = stsDefault') 934 ( 935 'Component = pnlSelectedTests' 936 'Status = stsDefault') 937 ( 938 'Component = lvSelectionList' 939 'Status = stsDefault') 940 ( 941 'Component = btnRemove' 942 'Status = stsDefault') 943 ( 944 'Component = btnRemoveAll' 945 'Status = stsDefault') 946 ( 947 'Component = cboReasons' 948 'Text = Applies to entire order' 949 'Status = stsOK') 950 ( 951 'Component = memDiagComment' 952 'Status = stsDefault') 953 ( 954 'Component = cboCollType' 955 'Status = stsDefault') 956 ( 957 'Component = cboCollTime' 958 'Status = stsDefault') 959 ( 960 'Component = calWantTime' 961 'Status = stsDefault') 962 ( 963 'Component = calCollTime' 964 'Status = stsDefault') 965 ( 966 'Component = txtImmedColl' 967 'Status = stsDefault') 968 ( 969 'Component = pnlCollTimeButton' 970 'Status = stsDefault')) 971 end 640 972 object dlgLabCollTime: TORDateTimeDlg 641 FMDateTime = 2980923 973 FMDateTime = 2980923.000000000000000000 642 974 DateOnly = False 643 975 RequireTime = True 644 976 Left = 435 645 Top = 12977 Top = 72 646 978 end 647 979 object ORWanted: TORDateTimeDlg 648 FMDateTime = 2980923 980 FMDateTime = 2980923.000000000000000000 649 981 DateOnly = False 650 982 RequireTime = True 651 Left = 335 652 Top = 12 653 end 654 object ImageList1: TImageList 655 Left = 388 656 Top = 12 657 Bitmap = { 658 494C010104000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 659 0000000000003600000028000000400000003000000001002000000000000030 660 0000000000000000000000000000000000000000000000000000000000000000 661 0000000000000000000000000000000000000000000000000000000000000000 662 0000000000000000000000000000000000000000000000000000000000000000 663 0000000000000000000000000000000000000000000000000000000000000000 664 0000000000000000000000000000000000000000000000000000000000000000 665 0000000000000000000000000000000000000000000000000000000000000000 666 0000000000000000000000000000000000000000000000000000000000000000 667 0000000000000000000000000000000000000000000000000000000000000000 668 0000000000000000000000000000000000000000000000000000000000000000 669 0000000000000000000000000000000000000000000000000000000000000000 670 0000000000000000000000000000000000000000000000000000000000000000 671 0000000000000000000000000000000000000000000000000000000000000000 672 0000000000000000000000000000000000000000000000000000000000000000 673 0000000000000000000000000000000000000000000000000000000000000000 674 0000000000000000000000000000000000000000000000000000000000000000 675 0000000000000000000000000000000000000000000000000000000000000000 676 0000000000000000000000000000000000000000000000000000000000000000 677 0000000000000000000000000000000000000000000000000000000000000000 678 0000000000000000000000000000000000000000000000000000000000000000 679 0000000000000000000000000000000000000000000000000000000000000000 680 0000000000000000000000000000000000000000000000000000000000000000 681 0000000000000000000000000000000000000000000000000000000000000000 682 0000000000000000000000000000000000000000000000000000000000000000 683 0000000000000000000000000000000000000000000000000000000000000000 684 0000000000000000000000000000000000000000000000000000000000000000 685 0000000000000000000000000000000000000000000000000000000000000000 686 0000000000000000000000000000000000000000000000000000000000000000 687 0000000000000000000000000000000000000000000000000000000000000000 688 0000000000000000000000000000000000000000000000000000000000000000 689 0000000000000000000000000000000000000000000000000000000000000000 690 0000000000000000000000000000000000000000000000000000000000000000 691 0000000000000000000000000000000000000000000000000000000000000000 692 0000000000000000000000000000000000000000000000000000000000000000 693 0000000000000000000000000000000000000000000000000000000000000000 694 0000000000000000000000000000000000000000000000000000000000000000 695 0000000000000000000000000000000000000000000000000000000000000000 696 0000000000000000000000000000000000000000000000000000000000000000 697 0000000000000000000000000000000000000000000000000000000000000000 698 0000000000000000000000000000000000000000000000000000000000000000 699 0000000000000000000000000000000000000000000000000000000000000000 700 0000000000000000000000000000000000000000000000000000000000000000 701 0000000000000000000000000000000000000000000000000000000000000000 702 0000000000000000000000000000000000000000000000000000000000000000 703 0000000000000000000000000000000000000000000000000000000000000000 704 0000000000000000000000000000000000000000000000000000000000000000 705 0000000000000000000000000000000000000000000000000000000000000000 706 0000000000000000000000000000000000000000000000000000000000000000 707 0000000000000000000000000000000000000000000000000000000000000000 708 0000000000000000000000000000000000000000000000000000000000000000 709 0000000000000000000000000000000000000000000000000000000000000000 710 0000000000000000000000000000000000000000000000000000000000000000 711 0000000000000000000000000000000000000000000000000000000000000000 712 0000000000000000000000000000000000000000000000000000000000000000 713 0000000000000000000000000000000000000000000000000000000000000000 714 0000000000000000000000000000000000000000000000000000000000000000 715 0000000000000000000000000000000000000000000000000000000000000000 716 0000000000000000000000000000000000000000000000000000000000000000 717 0000000000000000000000000000000000000000000000000000000000000000 718 0000000000000000000000000000000000000000000000000000000000000000 719 0000000000000000000000000000000000000000000000000000000000000000 720 0000000000000000000000000000000000000000000000000000000000000000 721 0000000000000000000000000000000000000000000000000000000000000000 722 0000000000000000000000000000000000000000000000000000000000000000 723 0000000000000000000000000000000000000000000000000000000000000000 724 0000000000000000000000000000000000000000000000000000000000000000 725 0000000000000000000000000000000000000000000000000000000000000000 726 0000000000000000000000000000000000000000000000000000000000000000 727 0000000000000000000000000000000000000000000000000000000000000000 728 0000000000000000000000000000000000000000000000000000000000000000 729 0000000000000000000000000000000000000000000000000000000000000000 730 0000000000000000000000000000000000000000000000000000000000000000 731 0000000000000000000000000000000000000000000000000000000000000000 732 0000000000000000000000000000000000000000000000000000000000000000 733 0000000000000000000000000000000000000000000000000000000000000000 734 0000000000000000000000000000000000000000000000000000000000000000 735 0000000000000000000000000000000000000000000000000000000000000000 736 0000000000000000000000000000000000000000000000000000000000000000 737 0000000000000000000000000000000000000000000000000000000000000000 738 0000000000000000000000000000000000000000000000000000000000000000 739 0000000000000000000000000000000000000000000000000000000000000000 740 0000000000000000000000000000000000000000000000000000000000000000 741 0000000000000000000000000000000000000000000000000000000000000000 742 0000000000000000000000000000000000000000000000000000000000000000 743 0000000000000000000000000000000000000000000000000000000000000000 744 0000000000000000000000000000000000000000000000000000000000000000 745 0000000000000000000000000000000000000000000000000000000000000000 746 0000000000000000000000000000000000000000000000000000000000000000 747 0000000000000000000000000000000000000000000000000000000000000000 748 0000000000000000000000000000000000000000000000000000000000000000 749 0000000000000000000000000000000000000000000000000000000000000000 750 0000000000000000000000000000000000000000000000000000000000000000 751 0000000000000000000000000000000000000000000000000000000000000000 752 0000000000000000000000000000000000000000000000000000000000000000 753 0000000000000000000000000000000000000000000000000000000000000000 754 0000000000000000000000000000000000000000000000000000000000000000 755 0000000000000000000000000000000000000000000000000000000000000000 756 0000000000000000000000000000000000000000000000000000000000000000 757 0000000000000000000000000000000000000000000000000000000000000000 758 0000000000000000000000000000000000000000000000000000000000000000 759 0000000000000000000000000000000000000000000000000000000000000000 760 0000000000000000000000000000000000000000000000000000000000000000 761 0000000000000000000000000000000000000000000000000000000000000000 762 0000000000000000000000000000000000000000000000000000000000000000 763 0000000000000000000000000000000000000000000000000000000000000000 764 0000000000000000000000000000000000000000000000000000000000000000 765 0000000000000000000000000000000000000000000000000000000000000000 766 0000000000000000000000000000000000000000000000000000000000000000 767 0000000000000000000000000000000000000000000000000000000000000000 768 0000000000000000000000000000000000000000000000000000000000000000 769 0000000000000000000000000000000000000000000000000000000000000000 770 0000000000000000000000000000000000000000000000000000000000000000 771 0000000000000000000000000000000000000000000000000000000000000000 772 0000000000000000000000000000000000000000000000000000000000000000 773 0000000000000000000000000000000000000000000000000000000000000000 774 0000000000000000000000000000000000000000000000000000000000000000 775 0000000000000000000000000000000000000000000000000000000000000000 776 0000000000000000000000000000000000000000000000000000000000000000 777 0000000000000000000000000000000000000000000000000000000000000000 778 0000000000000000000000000000000000000000000000000000000000000000 779 0000000000000000000000000000000000000000000000000000000000000000 780 0000000000000000000000000000000000000000000000000000000000000000 781 0000000000000000000000000000000000000000000000000000000000000000 782 0000000000000000000000000000000000000000000000000000000000000000 783 0000000000000000000000000000000000000000000000000000000000000000 784 0000000000000000000000000000000000000000000000000000000000000000 785 0000000000000000000000000000000000000000000000000000000000000000 786 0000000000000000000000000000000000000000000000000000000000000000 787 0000000000000000000000000000000000000000000000000000000000000000 788 0000000000000000000000000000000000000000000000000000000000000000 789 0000000000000000000000000000000000000000000000000000000000000000 790 0000000000000000000000000000000000000000000000000000000000000000 791 0000000000000000000000000000000000000000000000000000000000000000 792 0000000000000000000000000000000000000000000000000000000000000000 793 0000000000000000000000000000000000000000000000000000000000000000 794 0000000000000000000000000000000000000000000000000000000000000000 795 0000000000000000000000000000000000000000000000000000000000000000 796 0000000000000000000000000000000000000000000000000000000000000000 797 0000000000000000000000000000000000000000000000000000000000000000 798 0000000000000000000000000000000000000000000000000000000000000000 799 0000000000000000000000000000000000000000000000000000000000000000 800 0000000000000000000000000000000000000000000000000000000000000000 801 0000000000000000000000000000000000000000000000000000000000000000 802 0000000000000000000000000000000000000000000000000000000000000000 803 0000000000000000000000000000000000000000000000000000000000000000 804 0000000000000000000000000000000000000000000000000000000000000000 805 0000000000000000000000000000000000000000000000000000000000000000 806 0000000000000000000000000000000000000000000000000000000000000000 807 0000000000000000000000000000000000000000000000000000000000000000 808 0000000000000000000000000000000000000000000000000000000000000000 809 0000000000000000000000000000000000000000000000000000000000000000 810 0000000000000000000000000000000000000000000000000000000000000000 811 0000000000000000000000000000000000000000000000000000000000000000 812 0000000000000000000000000000000000000000000000000000000000000000 813 0000000000000000000000000000000000000000000000000000000000000000 814 0000000000000000000000000000000000000000000000000000000000000000 815 0000000000000000000000000000000000000000000000000000000000000000 816 0000000000000000000000000000000000000000000000000000000000000000 817 0000000000000000000000000000000000000000000000000000000000000000 818 0000000000000000000000000000000000000000000000000000000000000000 819 0000000000000000000000000000000000000000000000000000000000000000 820 0000000000000000000000000000000000000000000000000000000000000000 821 0000000000000000000000000000000000000000000000000000000000000000 822 0000000000000000000000000000000000000000000000000000000000000000 823 0000000000000000000000000000000000000000000000000000000000000000 824 0000000000000000000000000000000000000000000000000000000000000000 825 0000000000000000000000000000000000000000000000000000000000000000 826 0000000000000000000000000000000000000000000000000000000000000000 827 0000000000000000000000000000000000000000000000000000000000000000 828 0000000000000000000000000000000000000000000000000000000000000000 829 0000000000000000000000000000000000000000000000000000000000000000 830 0000000000000000000000000000000000000000000000000000000000000000 831 0000000000000000000000000000000000000000000000000000000000000000 832 0000000000000000000000000000000000000000000000000000000000000000 833 0000000000000000000000000000000000000000000000000000000000000000 834 0000000000000000000000000000000000000000000000000000000000000000 835 0000000000000000000000000000000000000000000000000000000000000000 836 0000000000000000000000000000000000000000000000000000000000000000 837 0000000000000000000000000000000000000000000000000000000000000000 838 0000000000000000000000000000000000000000000000000000000000000000 839 0000000000000000000000000000000000000000000000000000000000000000 840 0000000000000000000000000000000000000000000000000000000000000000 841 0000000000000000000000000000000000000000000000000000000000000000 842 0000000000000000000000000000000000000000000000000000000000000000 843 0000000000000000000000000000000000000000000000000000000000000000 844 0000000000000000000000000000000000000000000000000000000000000000 845 0000000000000000000000000000000000000000000000000000000000000000 846 0000000000000000000000000000000000000000000000000000000000000000 847 0000000000000000000000000000000000000000000000000000000000000000 848 0000000000000000000000000000000000000000000000000000000000000000 849 0000000000000000000000000000000000000000000000000000000000000000 850 0000000000000000000000000000000000000000000000000000000000000000 851 0000000000000000000000000000000000000000000000000000000000000000 852 0000000000000000000000000000000000000000000000000000000000000000 853 0000000000000000000000000000000000000000000000000000000000000000 854 0000000000000000000000000000000000000000000000000000000000000000 855 0000000000000000000000000000000000000000000000000000000000000000 856 0000000000000000000000000000000000000000000000000000000000000000 857 0000000000000000000000000000000000000000000000000000000000000000 858 0000000000000000000000000000000000000000000000000000000000000000 859 0000000000000000000000000000000000000000000000000000000000000000 860 0000000000000000000000000000000000000000000000000000000000000000 861 0000000000000000000000000000000000000000000000000000000000000000 862 0000000000000000000000000000000000000000000000000000000000000000 863 0000000000000000000000000000000000000000000000000000000000000000 864 0000000000000000000000000000000000000000000000000000000000000000 865 0000000000000000000000000000000000000000000000000000000000000000 866 0000000000000000000000000000000000000000000000000000000000000000 867 0000000000000000000000000000000000000000000000000000000000000000 868 0000000000000000000000000000000000000000000000000000000000000000 869 0000000000000000000000000000000000000000000000000000000000000000 870 0000000000000000000000000000000000000000000000000000000000000000 871 0000000000000000000000000000000000000000000000000000000000000000 872 0000000000000000000000000000000000000000000000000000000000000000 873 0000000000000000000000000000000000000000000000000000000000000000 874 0000000000000000000000000000000000000000000000000000000000000000 875 0000000000000000000000000000000000000000000000000000000000000000 876 0000000000000000000000000000000000000000000000000000000000000000 877 0000000000000000000000000000000000000000000000000000000000000000 878 0000000000000000000000000000000000000000000000000000000000000000 879 0000000000000000000000000000000000000000000000000000000000000000 880 0000000000000000000000000000000000000000000000000000000000000000 881 0000000000000000000000000000000000000000000000000000000000000000 882 0000000000000000000000000000000000000000000000000000000000000000 883 0000000000000000000000000000000000000000000000000000000000000000 884 0000000000000000000000000000000000000000000000000000000000000000 885 0000000000000000000000000000000000000000000000000000000000000000 886 0000000000000000000000000000000000000000000000000000000000000000 887 0000000000000000000000000000000000000000000000000000000000000000 888 0000000000000000000000000000000000000000000000000000000000000000 889 0000000000000000000000000000000000000000000000000000000000000000 890 0000000000000000000000000000000000000000000000000000000000000000 891 0000000000000000000000000000000000000000000000000000000000000000 892 0000000000000000000000000000000000000000000000000000000000000000 893 0000000000000000000000000000000000000000000000000000000000000000 894 0000000000000000000000000000000000000000000000000000000000000000 895 0000000000000000000000000000000000000000000000000000000000000000 896 0000000000000000000000000000000000000000000000000000000000000000 897 0000000000000000000000000000000000000000000000000000000000000000 898 0000000000000000000000000000000000000000000000000000000000000000 899 0000000000000000000000000000000000000000000000000000000000000000 900 0000000000000000000000000000000000000000000000000000000000000000 901 0000000000000000000000000000000000000000000000000000000000000000 902 0000000000000000000000000000000000000000000000000000000000000000 903 0000000000000000000000000000000000000000000000000000000000000000 904 0000000000000000000000000000000000000000000000000000000000000000 905 0000000000000000000000000000000000000000000000000000000000000000 906 0000000000000000000000000000000000000000000000000000000000000000 907 0000000000000000000000000000000000000000000000000000000000000000 908 0000000000000000000000000000000000000000000000000000000000000000 909 0000000000000000000000000000000000000000000000000000000000000000 910 0000000000000000000000000000000000000000000000000000000000000000 911 0000000000000000000000000000000000000000000000000000000000000000 912 0000000000000000000000000000000000000000000000000000000000000000 913 0000000000000000000000000000000000000000000000000000000000000000 914 0000000000000000000000000000000000000000000000000000000000000000 915 0000000000000000000000000000000000000000000000000000000000000000 916 0000000000000000000000000000000000000000000000000000000000000000 917 0000000000000000000000000000000000000000000000000000000000000000 918 0000000000000000000000000000000000000A0A0A002F2F2F00222222000C0C 919 0C0015151500262626002A2A2A001F1F1F0001010100171717001C1C1C001313 920 13001B1B1B00181818001616160000000000CFCFD000D9D9D900E2E2E200E9EA 921 EA00F1F1F300FAFDF600FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 922 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0017171700A2A2A200FFFFFF00FAFA 923 FA00A7B8110045BC3B0032C32100E0ED4B00DEF65200D8E34600B0B81800C4CC 924 2B00E3F45100D0F14900D5E34500AFA31D000000000000000000000000000000 925 0000000000000000000000000000000000000000000000000000000000000000 926 0000000000000000000000000000000000000700040005D0250006D6320006D8 927 260007F9070012FC0E0008FC000008FB0C000311ED000000FD00100ADF000000 928 110000000000000000000000000002020200DDDEDF00E5E5E600E8E8ED009896 929 A6004B4992004240BC003734BE003734C4003F3DCB005250D50079779700FFFF 930 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0056151700B2A09F00FAFAFA00F5F5 931 F500BD9E070036E1370096D53200DEEE4300E8E73F00D5EE4600B99D1000BEB7 932 1400E9E74200C7D12300AFD73B00D28229000000000000000000000000000000 933 0000000000000000000000000000000000000000000000000000000000000000 934 0000000000000000000000000000000000000600040001FF000001FF000001FF 935 000001FF000001FF000001FF000000FF05000EC4360004ED000004E119000000 936 270000000000000000000000000002020200E4E4E500E9EAE80063606B005C59 937 CB00544FCD004E48CD004944BC004540C800433FCD004A48D3006060DE009695 938 BD00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BF191800EDA6A300FCFCFC00FCFC 939 FC00A4A103005ECF770080D32A0046BD140081DD36009CE03500F2F54B007FCF 940 28006FCE2900EFF55400BAA81B00C78F20000000000000000000000000000000 941 0000000000000000000000000000000000000000000000000000000000000000 942 0000000000000000000000000000000000000500030001FF000001FF000001FF 943 000001FF000001FF000001FF000001FF000001FF000010FD020005FF05000500 944 000000000000000000000000000002020200E9EAE7009D99BF007773EC007A75 945 F6007C75F700756EF4006D66E800635DDA00514DD0004A47D3005451D8006E6C 946 DB00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CF292800F2ABA800FCFCFC00FCFC 947 FC00C2B91600CFC8250066C61B0036DB340021AB0600DCEF4C00F0F8510047BB 948 140022BE1900F4F34F00C2911700B7B415000000000000000000000000000000 949 0000000000000000000000000000000000000000000000000000000000000000 950 0000000000000000000000000000000000000801060001FF000001FF000001FF 951 000001FF000001FF000001FF000001FF000001FF000010FD020005FF05000500 952 000000000000000000000000000002020200EBEBED00A9A6D7009691F6009B95 953 FB00AAA3FF00A79EFF009B93FF00837AF2006761D5005651C3005753D6006C6A 954 DE00FDFEFF00FFFFFF00FFFFFF00FFFFFF00D57C2C00F2CAAE00FEFEFE00FCFC 955 FC00F4FC5500E4F14F0057C41A003EE33C0043BD1500C0E94000F2F14900B0DD 956 3A000DB60C00EFF24800D0F04500E1AD7E000000000000000000000000000000 957 0000000000000000000000000000000000000000000000000000000000000000 958 0000000000000000000000000000000000000500030001FF000001FF000001FF 959 000001FF000001FF000001FF000001FF000001FF000010FD020005FF05000500 960 000000000000000000000000000002020200EDEDEE00EAEAEE00ABA5F600BAB5 961 FB00E9E6FC00FFFFFF00D4D1FF009A92FD007770E400615CCB005F5BD400726F 962 D900FFFFFF00FFFFFF00FFFFFF00FFFFFF00CFCF2900F0ECA500FCFCFC00FCFC 963 FC0042F0450019B215001CBC160017B70B0079D42B0025D52A00E9F64E004BC0 964 17002FC31700D9F34C003FB90F00FFFFF3000000000000000000000000000000 965 0000000000000000000000000000000000000000000000000000000000000000 966 0000000000000000000000000000000000000D060B0001FF000000EB110000FF 967 0B000DFE070001FF000001FF000001FF000000EE0F000AFD080006F806000802 968 030000000000000000000000000002020200EDEDEE00F1F1F200EDECEF00B9B3 969 F800C1BBFC00D1D0FE00BEB6FF00968DFF007973EC006863D4006B67CA008381 970 B800FFFFFF00FFFFFF00FFFFFF00FFFFFF009ED52A00D5EFA300FCFCFC00FCFC 971 FC005DE8610050F57C009FDE3A003FE33E001EBA150027C017008AD92E003EC3 972 1F0026BB14007FDE3A0037BB1000FFF2FA000000000000000000000000000000 973 0000000000000000000000000000000000000000000000000000000000000000 974 0000000000000000000000000000000000000500030001FF000000DC1D0001FF 975 000006FF000001FF000001FF000001FF00000BFF070010FD020001FF00000500 976 000000000000000000000000000002020200EBEBEC00EFEFEF00F2F1F300F4F3 977 F300ABA7F100A39DF7009E8EFE00887AFF006D69E2006965CF007471C500E9EB 978 F900FFFFFF00FFFFFF00FFFFFF00FFFFFF001DBF2A00A2E79E00FCFCFC00FCFC 979 FC00BAAA670078EBD80034DE48004FF6870034D6360086CB2E00A1E032009FE2 980 430022D931007DF96900E2F2F900FCFCFC000000000000000000000000000000 981 0000000000000000000000000000000000000000000000000000000000000000 982 0000000000000000000000000000000000000801060001FF000000E1220001FF 983 000006FF000001FF000000FE000001FF000009FF070010FD020001FF00000500 984 000000000000000000000000000002020200E5E5E500E9E9EA00ECECED00EFEF 985 F000EFEEF1008A85E200736EF600635EF700615EC9006B68B000BCBCDC00FFFF 986 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0050FB9F00B0FFD800F9F9F900FBFB 987 FB00FCFCFC00FAFAFA006EB247002FFF860017AD13009BD53A000FB0000025C1 988 2700DCE2D100FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000 989 0000000000000000000000000000000000000000000000000000000000000000 990 0000000000000000000000000000000000000C00030001FF000000E1220001FF 991 000006FF000001FF00000EFC000007FC02000AE4210010FF000002FF00000901 992 010000000000000000000000000002020200DBDBDB00E0E0E100E5E5E600E8E8 993 E900EAE9EA00E7EBE6005F5EDE005858EF005F60A2008989B300FCFBFD00FFFF 994 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0042DBEA00ACECF700FFFFFF00FBFB 995 FB00FCFCFC00FDFDFD00FFE9FF00EEDDC200127DBA0035D73C0043C70800E2C5 996 A000FFFEFF00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000 997 0000000000000000000000000000000000000000000000000000000000000000 998 0000000000000000000000000000000000000500030003FF000000DD2A0001FF 999 000006FF000002FD020005FF000000FF000000180A0004FF07001ECB16000002 1000 000000000000000000000000000002020200C9C9CA00D0D0D100D7D8D800DCDC 1001 DD00DEDFE000E0E1E100E1E0E0005353E3005A5D7500EDF0F100F6F9F900FAFB 1002 FB00FDFDFE00FEFEFE00FFFFFF00FFFFFF006393E500BAD2EE00FCFCFC00FCFC 1003 FC00FCFCFC00FCFCFC00FCFCFC00FFFFF800DE39D600167EB90044D8EE00F5FA 1004 FF00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000 1005 0000000000000000000000000000000000000000000000000000000000000000 1006 0000000000000000000000000000000000000902070000FF000000DD2A0001FF 1007 000006FF00000DF6060015751A0007FF00000806060003FF0000001000000005 1008 000000000000000000000000000002020200B7B8B800BCBDBD00C4C5C500CCCD 1009 CD00D1D1D100D4D5D500D7D7D800C6C5D0004D4EA900E5E6E300EDEEED00F3F4 1010 F400F8F8F800FBFBFB00FCFCFC00FCFDFD00DC3BD300F0AAF000FDFDFD00FCFC 1011 FC00FCFCFC00FCFCFC00FCFCFC00F1F2FF00C820B9001EA8B4005BCAFA00EAEC 1012 FF00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000 1013 0000000000000000000000000000000000000000000000000000000000000000 1014 0000000000000000000000000000000000000500030000FF000000DD2A0001FF 1015 000006FF00000DB0000020001C0000F500001300140025000D00000200000401 1016 000000000000000000000000000002020200A5A5A600A5A5A600ACADAD00B5B5 1017 B500BDBCBD0000000000C6C7C800CBC8CB00B1B0C400BDBDC100DDDDDB00E4E4 1018 E400EAEAEA00EEEFEF00F1F2F200F2F3F300E03FD700F3ADF300F8F8F800FCFC 1019 FC00FCFCFC00FCFCFC00FCFCFC00CCC7C600AD68C900515ADA0035C83600B185 1020 8600FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000 1021 0000000000000000000000000000000000000000000000000000000000000000 1022 0000000000000000000000000000000000000A03080000FF000000D7240001FF 1023 0000000600001D3F160000010000219024000000070000000000020103000000 1024 0000000000000000000000000000020202008F8F8F008F8F8F008F8F8F009596 1025 96009D9E9E00A5A5A600AAABAB00B0B0B100B6B6B700BAB8BA009C9DA100C5C6 1026 C700CDCECE00D2D2D300D5D5D600D6D6D600A71BC200DE9FE500FCFCFC00FCFC 1027 FC00FCFCFC00FCFCFC00FCFCFC00DA971200AFB91300CEA42100E86B2100677E 1028 AE00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000 1029 0000000000000000000000000000000000000000000000000000000000000000 1030 0000000000000000000000000000000000000903000014F70600130830000BED 1031 00000200010008000A0003020400000700000000070000000000020103000000 1032 0000000000000000000000000000020202007C7D7D007C7D7D007C7D7D007C7D 1033 7D007E7E7E00848585008B8B8C0091919200979798009C9D9D00A1A1A000A3A4 1034 A200A8A9A900AEAEAE00B1B1B100B2B2B3003A2EFF00B0ADFD00FEFEFE00FFFF 1035 FF00FCFCFC00FCFCFC00FFFCFF00AAD83100FAF8FE00511C1900FAE7F000EDD8 1036 E000FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000 1037 0000000000000000000000000000000000000000000000000000000000000000 1038 00000000000000000000000000000000000013131300161616000A0D11000000 1039 0000030408000101010001010100010101000000030001010100000100000101 1040 0100010101000101010001010100020202006B6B6C006B6B6C006B6B6C006B6B 1041 6C006B6B6C006B6B6C006B6B6C006D6D6E0072727200767677007A7B7B007E7E 1042 7E00818182008484840087878700888889000C04F10099A0F000F7F7F700FBFB 1043 FB00FCFCFC00FCFCFC00FDFFFF00FFF7FF0057262400CE5C45009A252200B8C9 1044 C600FCFCFC00FCFCFC00FCFCFC00FCFCFC00424D3E000000000000003E000000 1045 2800000040000000300000000100010000000000800100000000000000000000 1046 000000000000000000000000FFFFFF0000000000000000000000000000000000 1047 0000000000000000000000000000000000000000000000000000000000000000 1048 0000000000000000000000000000000000000000000000000000000000000000 1049 0000000000000000000000000000000000000000000000000000000000000000 1050 0000000000000000000000000000000000000000000000000000000000000000 1051 0000000000000000000000000000000000000000000000000000000000000000 1052 0000000000000000000000000000000000000000000000000000000000000000 1053 0000000000000000000000000000000000000000000000000000000000000000 1054 00000000000000000000000000000000FFFF000000000000FFFF000000000000 1055 FFFF000000000000FFFF000000000000FFFF000000000000FFFF000000000000 1056 FFFF000000000000FFFF000000000000FFFF000000000000FFFF000000000000 1057 FFFF000000000000FFFF000000000000FFFF000004000000FFFF000000000000 1058 FFFF000000000000FFFF00000000000000000000000000000000000000000000 1059 000000000000} 983 Left = 343 984 Top = 72 1060 985 end 1061 986 end -
cprs/trunk/CPRS-Chart/Orders/fODBBank.pas
r456 r829 1 1 unit fODBBank; 2 3 2 interface 4 3 … … 6 5 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 7 6 Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst, 8 ORDtTm, Buttons, Menus, ImgList ;7 ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils; 9 8 10 9 type 11 10 TfrmODBBank = class(TfrmODBase) 12 pnlBB: TPanel; 13 pnlFull: TPanel; 11 dlgLabCollTime: TORDateTimeDlg; 12 ORWanted: TORDateTimeDlg; 13 pnlComments: TPanel; 14 btnUpdateComments: TButton; 15 btnCancelComment: TButton; 16 lblOrdComment: TLabel; 14 17 pgeProduct: TPageControl; 15 tabInfo: TTabSheet;18 TabInfo: TTabSheet; 16 19 edtInfo: TCaptionRichEdit; 17 20 TabDiag: TTabSheet; 18 21 lblReqComment: TOROffsetLabel; 22 TabResults: TTabSheet; 23 edtResults: TCaptionRichEdit; 19 24 pnlFields: TPanel; 20 dlgLabCollTime: TORDateTimeDlg;21 ORWanted: TORDateTimeDlg;22 25 lblDiagComment: TOROffsetLabel; 23 txtDiagComment: TCaptionEdit;24 pnlSelectedTests: TGroupBox;25 lvSelectionList: TCaptionListView;26 26 lblUrgency: TLabel; 27 lblReason: TLabel; 28 lblSurgery: TLabel; 27 29 cboUrgency: TORComboBox; 28 lblCollType: TLabel;29 cboCollType: TORComboBox;30 30 chkConsent: TCheckBox; 31 lblPreparation: TLabel;32 calWantTime: TORDateBox;33 lblWanted: TLabel;34 tReason: TEdit;35 lblReason: TLabel;36 31 cboSurgery: TORComboBox; 37 lblSurgery: TLabel;38 txtImmedColl: TCaptionEdit;39 cboCollTime: TORComboBox;40 lblCollTime: TLabel;41 cmdImmedColl: TSpeedButton;42 pnlCollTimeButton: TKeyClickPanel;43 calCollTime: TORDateBox;44 cboPreparation: TORComboBox;45 btnRemove: TButton;46 btnRemoveAll: TButton;47 pnlTop: TPanel;48 32 pnlSelect: TPanel; 49 pnlDiag Tests: TGroupBox;33 pnlDiagnosticTests: TGroupBox; 50 34 cboAvailTest: TORComboBox; 51 35 pnlBloodComponents: TGroupBox; 52 36 lblQuantity: TLabel; 37 lblModifiers: TLabel; 53 38 cboAvailComp: TORComboBox; 54 39 tQuantity: TEdit; 55 upQuantity: TUpDown;56 TabResults: TTabSheet;57 edtResults: TCaptionRichEdit;58 btnAddTests: TORAlignSpeedButton;59 ImageList1: TImageList;60 lblModifiers: TLabel;61 40 cboModifiers: TORComboBox; 41 GroupBox1: TGroupBox; 42 cboQuick: TORComboBox; 43 pnlSelectedTests: TGroupBox; 44 lvSelectionList: TCaptionListView; 45 btnRemove: TButton; 46 btnRemoveAll: TButton; 47 cboReasons: TORComboBox; 48 lblRequiredField: TLabel; 49 memDiagComment: TRichEdit; 50 lblCollType: TLabel; 51 cboCollType: TORComboBox; 52 lblCollTime: TLabel; 53 cboCollTime: TORComboBox; 54 calWantTime: TORDateBox; 55 lblWanted: TLabel; 56 calCollTime: TORDateBox; 57 txtImmedColl: TCaptionEdit; 58 pnlCollTimeButton: TKeyClickPanel; 59 cmdImmedColl: TSpeedButton; 62 60 lblTNS: TLabel; 63 61 procedure FormCreate(Sender: TObject); … … 78 76 procedure pgeProductChange(Sender: TObject); 79 77 procedure cboCollTypeChange(Sender: TObject); 80 procedure btnAddTestsClick(Sender: TObject);81 78 procedure FormDestroy(Sender: TObject); 82 79 procedure btnRemoveClick(Sender: TObject); … … 86 83 procedure chkConsentClick(Sender: TObject); 87 84 procedure cboUrgencyChange(Sender: TObject); 88 procedure txtDiagCommentChange(Sender: TObject);89 procedure cboPreparationChange(Sender: TObject);90 85 procedure cboSurgeryChange(Sender: TObject); 91 procedure tReasonChange(Sender: TObject);92 86 procedure calCollTimeChange(Sender: TObject); 87 procedure cboQuickClick(Sender: TObject); 88 procedure tQuantityEnter(Sender: TObject); 89 procedure btnUpdateCommentsClick(Sender: TObject); 90 procedure btnCancelCommentClick(Sender: TObject); 91 procedure cboSurgeryClick(Sender: TObject); 92 procedure cboReasonsEnter(Sender: TObject); 93 procedure cboReasonsExit(Sender: TObject); 94 procedure tQuantityClick(Sender: TObject); 95 procedure tQuantityChange(Sender: TObject); 96 procedure cboReasonsChange(Sender: TObject); 97 procedure cboModifiersChange(Sender: TObject); 98 procedure lvSelectionListClick(Sender: TObject); 99 procedure cboAvailCompChange(Sender: TObject); 100 procedure cboCollTimeChange(Sender: TObject); 101 procedure memDiagCommentChange(Sender: TObject); 102 procedure cboUrgencyExit(Sender: TObject); 93 103 protected 94 104 FCmtTypes: TStringList ; … … 106 116 procedure ExtractSurgeries(OutList:TStrings; AList:TStrings); 107 117 procedure ExtractUrgencies(OutList:TStrings; AList:TStrings); 118 procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings); 108 119 procedure ExtractModifiers(OutList:TStrings; AList:TStrings); 120 procedure ExtractReasons(OutList:TStrings; AList:TStrings); 109 121 procedure ExtractSpecimens(OutList:TStrings; AList:TStrings); 110 122 procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings); 123 procedure ExtractOther(OutList:TStrings; AList:TStrings); 111 124 procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings); 112 125 procedure ExtractSpecimen(OutList:TStrings; AList:TStrings); … … 114 127 procedure LoadUrgencies(AComboBox:TORComboBox); 115 128 procedure LoadModifiers(AComboBox:TORComboBox); 129 procedure LoadReasons(AComboBox:TORComboBox); 130 116 131 private 117 132 FLastCollType: string; … … 123 138 FEvtDivision: integer; 124 139 FVbecLookup: string; 140 FQuickList: Integer; 141 FQuickItems: TStringList; 142 FOrderAction: Integer; 125 143 procedure ReadServerVariables; 144 procedure SetOnQuickOrder; 126 145 public 127 146 procedure SetupDialog(OrderAction: Integer; const ID: string); override; … … 153 172 CollSamp: Integer; { index into CollSampList } 154 173 Specimen: Integer; { IEN of specimen } 174 Urgency: Integer; { IEN of urgency } 155 175 Comment: TStringList; { text of comment } 156 176 TestReqComment: string; { Name of required comment } … … 162 182 SpecimenList: TStringList; { Strings: IEN^Specimen Name } 163 183 SpecListCount: integer; { count of original contents of SpecimenList} 184 UrgencyList: TStringList; { Strings: IEN^Urgency Name } 185 ForceUrgency: Boolean; { true if not prompt Urgency } 164 186 SurgeryList: TStringList; { Strings: Surgeries} 165 187 PatientInfo: TStringList; { Text of Patient Information} … … 179 201 procedure LoadCollSamp(AComboBox: TORComboBox); 180 202 procedure LoadSpecimen(AComboBox: TORComboBox); 203 procedure LoadUrgency(CollType: string; AComboBox:TORComboBox); 181 204 function NameOfCollSamp: string; 182 205 function NameOfSpecimen: string; 206 function NameOfUrgency: string; 183 207 function ObtainCollSamp: Boolean; 184 208 function ObtainSpecimen: Boolean; 209 function ObtainUrgency: Boolean; 185 210 function ObtainComment: Boolean; 211 186 212 end; 187 213 … … 202 228 var 203 229 uSelectedItems: TStringList; //Selected Items in ListView- if TestYes =1 then test else component 204 //TestYes(1)^Test-Component(2)^Qty(3)^ Sample(4,5)^Specimen(6,7)^Modifier(8)230 //TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8) 205 231 uVBECList: TStringList; //List of items from VBEC api 206 232 uTestsForResults: TStringList; //List of tests to show results 207 233 uUrgencyList: TStringList; //List of Urgencies 234 uTNSOrders: TStringList; //List of Current orders for Type & Screen 208 235 uModifierList: TStringList; //List of Modifiers 236 uReasonsList: TStringList; //List of Reasons for Request 209 237 uRaw: TStringList; //Results Array 210 238 uTestSelected, uComponentSelected: Boolean; //Used on Validate 211 uDfltUrgency: Integer; 239 uDfltUrgency: Integer; //Default Urgency 240 uSelUrgency: String; //Previously Selected Urgency - Used when components have been added for specific urgency 241 uSelSurgery: Integer; //Selected Surgery for Blood order 212 242 uSpecimen, uGetTnS: Integer; //Set to 1 if a specimen for test is already in lab... no need to collect 213 uDfltCollType : string;243 uDfltCollType, uReason: string; 214 244 ALabTest: TLabTest; 215 245 UserHasLRLABKey: boolean; … … 228 258 229 259 TI_INFO = 0; //Corresponds with pgeProduct TabIndex 230 TI_ ORDER= 1;260 TI_COMPONENT = 1; 231 261 TI_RESULTS = 2; 232 262 … … 239 269 i: integer; 240 270 AList, ATests: TStringList; 271 ListCount: Integer; 272 x: string; 241 273 begin 242 274 AutoSizeDisabled := True; … … 248 280 uTestsForResults := TStringList.Create; 249 281 uUrgencyList := TStringList.Create; 282 uTNSOrders := TStringList.Create; 250 283 uModifierList := TStringList.Create; 284 uReasonsList := TStringList.Create; 251 285 uRaw := TStringList.Create; 252 286 uSpecimen := 0; 253 287 uGetTnS := 0; 288 uReason := ''; 254 289 lblTNS.Caption := ''; 255 290 lblTNS.Visible := false; 291 pnlMessage.Visible := false; 256 292 uDfltUrgency := 9; 257 TabResults.ImageIndex := 0; 293 uSelUrgency := ''; 294 uSelSurgery := 0; 295 TabResults.Caption := 'Lab Results'; 296 edtResults.Lines.Clear; 297 edtResults.Lines.Add('Lab results are ONLY available after selecting/adding a component on the Blood Bank Orders tab that has been designated for results retrieval.'); 258 298 Responses.Clear; 259 299 try … … 265 305 LRFSCH := ''; 266 306 LRORDERMODE := TORDER_MODE_INFO; 267 DisableComponentControls;268 DisableDiagTestControls;269 307 FLastColltime := ''; 270 308 FLastLabCollTime := ''; … … 277 315 AllowQuickOrder := True; 278 316 StatusText('Loading Dialog Definition'); 279 lblReqComment.Visible := False ;280 lblModifiers.Enabled := False;281 cboModifiers.Enabled := False;282 317 FCmtTypes := TStringList.Create; 283 318 for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ; … … 289 324 EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0); 290 325 if EvtDelayLoc>0 then 291 AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))326 FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList) 292 327 else 293 AList.Assign(ODForLab(Encounter.Location,EvtDivision));328 FastAssign(ODForLab(Encounter.Location,EvtDivision), AList); 294 329 end else 295 AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults330 FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults 296 331 CtrlInits.LoadDefaults(AList); 297 332 InitDialog; 333 GroupBox1.Visible := True; 298 334 with CtrlInits do 299 335 begin … … 309 345 StatusText('Initializing List of Tests'); 310 346 FVbecLookup := 'S.VBT'; 311 cboAvailTest.InitLongList(''); 347 cboAvailTest.InitLongList(''); //Populates cboAvailTest control based on S.VBT xref 312 348 end; 313 349 cboAvailComp.Clear; … … 329 365 AList.Clear; 330 366 ExtractUrgencies(uUrgencyList, uVBECList); 367 ExtractTNSOrders(uTNSOrders, uVBECList); 331 368 LoadUrgencies(cboUrgency); 332 cboUrgency.SelectByID(IntToStr(uDfltUrgency));333 369 ExtractModifiers(uModifierList, uVBECList); 370 ExtractReasons(uReasonsList, uVBECList); 334 371 LoadModifiers(cboModifiers); 335 calWantTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now)); 336 //cboPreparation.SelectByID('I'); 337 memMessage.Visible := false; 338 memOrder.Visible := false; 339 cmdAccept.Visible := false; 372 LoadReasons(cboReasons); 373 calWantTime.Text := 'NOW'; //FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now)); 340 374 pgeProduct.TabIndex := TI_INFO; 341 lvSelectionList.Column[0].Width := 200; 342 lvSelectionList.Column[1].Width := 40; 375 lvSelectionList.Column[0].Width := 240; 376 lvSelectionList.Column[1].Width := 30; 377 lvSelectionList.Column[2].Width := 100; 378 DisableComponentControls; 379 DisableDiagTestControls; 343 380 pgeProduct.ActivePageIndex := TI_INFO; 344 PreserveControl(cboAvailTest);345 PreserveControl(cboAvailComp);346 PreserveControl(cboCollType);347 PreserveControl(cboCollTime);348 PreserveControl(calCollTime);349 PreserveControl(calWantTime);350 381 StatusText(''); 351 382 x := 'VBEC'; 383 FQuickItems := TStringList.Create; 384 ListForQuickOrders(FQuickList, ListCount, x); 385 if ListCount > 0 then 386 begin 387 SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0); 388 end else 389 begin 390 ListCount := 1; 391 FQuickItems.Add('0^(No quick orders available)'); 392 end; 393 394 FastAssign(FQuickItems, cboQuick.Items); 395 if lvSelectionList.Items.Count > 0 then 396 begin 397 memOrder.Visible := true; 398 cmdAccept.Visible := true; 399 end; 352 400 finally 353 401 AList.Free; … … 375 423 procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string); 376 424 var 377 tmpResp: TResponse; 425 AnInstance, CurAdd: Integer; 426 AResponse: TResponse; 427 i, j, k, aTNS, aTNSDays, getTest, TestAdded: integer; 428 aStr, aTestYes, aName, aTypeScreen, aSpecimen, aModifier, sub, sub1, x, aTNSString: string; 429 ListItem: TListItem; 430 aList: TStringList; 431 aTests: TStringList; 432 begin 433 inherited; 434 aList := TStringList.Create; 435 aTests:= TStringList.Create; 436 try 437 FOrderAction := OrderAction; 438 ReadServerVariables; 439 sub1 := ''; 440 aTypeScreen := ''; 441 aSpecimen := '^'; 442 aModifier := ''; 443 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do 444 begin 445 AnInstance := NextInstance('ORDERABLE', 0); 446 while AnInstance > 0 do 447 begin 448 AResponse := FindResponseByName('ORDERABLE', AnInstance); 449 if AResponse <> nil then 450 begin 451 sub := GetSubtype(AResponse.EValue); 452 if sub = 't' then 453 begin 454 SetControl(cboAvailTest, 'ORDERABLE', AnInstance); 455 ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses); 456 end 457 else 458 begin 459 SetControl(cboAvailComp, 'ORDERABLE', AnInstance); 460 ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses); 461 end; 462 if ALabTest = nil then Exit; // Causes access violation 463 if AnInstance = 1 then 464 begin 465 SetControl(cboReasons, 'REASON' , AnInstance); 466 SetControl(calWantTime, 'DATETIME', AnInstance); 467 SetControl(memDiagComment, 'COMMENT', AnInstance); 468 SetControl(chkConsent, 'YN', AnInstance); 469 //DetermineCollectionDefaults(Responses); 470 SetControl(cboCollType, 'COLLECT', AnInstance); 471 SetControl(cboCollTime, 'START', AnInstance); 472 SetupCollTimes(cboCollType.ItemID); 473 SetControl(cboUrgency, 'URGENCY', AnInstance); 474 SetControl(cboSurgery, 'MISC', AnInstance); 475 Urgency := cboUrgency.ItemIEN; 476 if (Urgency = 0) and (cboUrgency.Items.Count = 1) then 477 begin 478 cboUrgency.ItemIndex := 0; 479 Urgency := cboUrgency.ItemIEN; 480 end; 481 i := 1 ; 482 AResponse := Responses.FindResponseByName('COMMENT',i); 483 while AResponse <> nil do 484 begin 485 Comment.Add(AResponse.EValue); 486 Inc(i); 487 AResponse := Responses.FindResponseByName('COMMENT',i); 488 end ; 489 end; 490 if sub = 't' then with ALabTest do //DIAGNOSTIC TEST 491 begin 492 Changing := True; 493 DisableComponentControls; 494 EnableDiagTestControls; 495 LRORDERMODE := TORDER_MODE_DIAG; 496 aList.Clear; 497 aTestYes := '1'; 498 ExtractTypeScreen(aList, uVBECList); 499 if aList.Count > 0 then aTypeScreen := aList[0]; 500 aList.Clear; 501 with lvSelectionList do 502 begin 503 ListItem := Items.Add; 504 ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2); 505 ListItem.SubItems.Add(''); 506 ListItem.SubItems.Add(''); 507 ListItem.SubItems.Add(''); 508 ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1)); 509 if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then 510 begin 511 lblTNS.Caption := ''; 512 lblTNS.Visible := false; 513 memMessage.Text := ''; 514 pnlMessage.Visible := false; 515 uGetTnS := 0; 516 pnlDiagnosticTests.Caption := 'Diagnostic Tests'; 517 end; 518 end; 519 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests 520 uSelectedItems.Add(aStr); 521 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 522 {with cboCollType do if Length(ItemID) > 0 then 523 begin 524 Responses.Update('COLLECT', 1, ItemID, ItemID) ; 525 FLastCollType := ItemID; 526 end; } 527 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 528 if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); 529 if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text); 530 LoadCollType(cboCollType); 531 if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then 532 if not(ALabTest.LabCanCollect) and OrderForInpatient then 533 cboCollType.SelectByID('WC') 534 else if not(ALabTest.LabCanCollect) then 535 cboCollType.SelectByID('SP'); 536 SetupCollTimes(cboCollType.ItemID); 537 if cboCollType.ItemID = 'LC' then 538 begin 539 with cboCollTime do 540 if Length(ItemID) > 0 then 541 begin 542 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999)); 543 FLastLabCollTime := ItemID + U + Text; 544 end 545 else if Length(Text) > 0 then 546 begin 547 Responses.Update('START', 1, ValidCollTime(Text), Text) ; 548 FLastLabCollTime := ValidCollTime(Text); 549 end; 550 end 551 else 552 begin 553 with calCollTime do 554 if FMDateTime > 0 then 555 begin 556 Responses.Update('START', 1, ValidCollTime(Text), Text); 557 FLastColltime := ValidCollTime(Text); 558 end 559 else 560 begin 561 Responses.Update('START', 1, '', '') ; 562 FLastCollTime := ''; 563 end; 564 end; 565 with cboCollType do if Length(ItemID) > 0 then 566 begin 567 Responses.Update('COLLECT', 1, ItemID, ItemID) ; 568 FLastCollType := ItemID; 569 end; 570 //if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID); 571 memOrder.Text := Responses.OrderText; 572 Changing := False; 573 if ObtainCollSamp then 574 begin 575 //For BloodBank orders, this condition should never occur 576 end 577 else 578 begin 579 with ALabTest do 580 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do 581 begin 582 x := '' ; 583 for i := 0 to WardComment.Count-1 do 584 x := x + WardComment.strings[i]+#13#10 ; 585 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1; 586 OrderMessage(x) ; 587 end ; 588 end; 589 end; 590 if sub = 'c' then with ALabTest do //COMPONENT 591 begin 592 Changing := True; 593 DisableDiagTestControls; 594 EnableComponentControls; 595 aTestYes := '0'; 596 LRORDERMODE := TORDER_MODE_COMP; 597 SetControl(cboModifiers, 'MODIFIER', AnInstance); 598 SetControl(tQuantity, 'QTY', AnInstance); 599 uComponentSelected := true; 600 aList.Clear; 601 TestAdded := 0; 602 getTest := 0; 603 ExtractTests(aList, uVBECList); //Get Results associated with ordered components 604 for j := 0 to aList.Count - 1 do 605 begin 606 if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then 607 begin 608 if uTestsForResults.Count < 1 then getTest := 1; 609 for k := 0 to uTestsForResults.Count - 1 do 610 begin 611 if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then 612 begin 613 getTest := 0; 614 break; 615 end 616 else getTest := 1; 617 end; 618 if getTest = 1 then 619 begin 620 uTestsForResults.Add(piece(aList[j],'^',3)); 621 TestAdded := 1; 622 end; 623 end; 624 end; 625 if TestAdded = 1 then 626 begin 627 edtResults.Clear; 628 aTests.Clear; 629 GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults); 630 QuickCopy(ATests,edtResults); 631 if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1; 632 uRaw.Clear; 633 GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults); 634 end; 635 CurAdd := 1; 636 if uRaw.Count > 0 then 637 for j := 0 to uRaw.Count - 1 do 638 begin 639 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1)); 640 Inc(CurAdd); 641 end; 642 with lvSelectionList do 643 begin 644 ListItem := Items.Add; 645 ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2); 646 ListItem.SubItems.Add(tQuantity.Text); 647 if length(cboModifiers.ItemID) > 0 then 648 begin 649 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); 650 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); 651 end 652 else 653 begin 654 ListItem.SubItems.Add(''); 655 ListItem.SubItems.Add(''); 656 end; 657 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); 658 end; 659 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests 660 uSelectedItems.Add(aStr); 661 memOrder.Text := Responses.OrderText; 662 Changing := False; 663 end; 664 end; 665 StatusText(''); 666 AnInstance := NextInstance('ORDERABLE', AnInstance); 667 end; //while AnInstance - ORDERABLE 668 DisableComponentControls; 669 DisableDiagTestControls; 670 end; 671 CurAdd := 1; 672 for i := 0 to uSelectedItems.Count - 1 do 673 begin 674 aName := lvSelectionList.Items[i].Caption; 675 x := uSelectedItems[i]; 676 if piece(x,'^',1) = '1' then //Diagnostic Test related fields 677 begin 678 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 679 end 680 else 681 begin 682 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 683 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3)); 684 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4)); 685 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5)); 686 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 687 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 688 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text) 689 else 690 begin 691 cboUrgency.ItemIndex := 1; 692 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 693 cboUrgencyChange(self); 694 end; 695 end; 696 Inc(CurAdd); 697 end; 698 for i := 0 to lvSelectionList.Items.Count - 1 do 699 begin 700 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then 701 begin 702 if uTNSOrders.Count > 0 then 703 begin 704 for j := 0 to uTNSOrders.Count - 1 do 705 aTNSString := aTNSString + CRLF + uTNSOrders[j]; 706 with Application do 707 begin 708 NormalizeTopMosts; 709 aTNSDays := TNSDaysBack; 710 aTNS := 711 MessageBox(PChar(aTNSString + CRLF + CRLF + 712 'Do you wish to continue with this request for Type & Screen?'), 713 PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'), 714 MB_YESNO); 715 RestoreTopMosts; 716 if aTNS = 7 then 717 begin 718 lvSelectionList.ItemIndex := i; 719 lvSelectionListClick(self); 720 btnRemoveClick(self); 721 break; 722 end; 723 end; 724 end; 725 break; 726 end; 727 end; 728 {if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do 729 begin 730 if OrderAction in [ORDER_QUICK, ORDER_EDIT] then uQuickInProcess := 1; 731 AnInstance := NextInstance('ORDERABLE', 0); 732 while AnInstance > 0 do 733 begin 734 AResponse := FindResponseByName('ORDERABLE', AnInstance); 735 if AResponse <> nil then 736 begin 737 sub := GetSubtype(AResponse.EValue); 738 if sub = 't' then 739 begin 740 SetControl(cboAvailTest, 'ORDERABLE', AnInstance); 741 ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses); 742 end 743 else 744 begin 745 SetControl(cboAvailComp, 'ORDERABLE', AnInstance); 746 ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses); 747 end; 748 //SetControl(cboTests, 'ORDERABLE', AnInstance); 749 //ALabTest := TLabTest.Create(cboTests.ItemID, Responses); 750 if ALabTest = nil then Exit; // Causes access violation 751 //sub := GetSubtype(ALabTest.TestName); 752 if AnInstance = 1 then 753 begin 754 DetermineCollectionDefaults(Responses); 755 SetControl(cboReasons, 'REASON', AnInstance); 756 SetControl(chkConsent, 'YN', AnInstance); 757 SetControl(cboSurgery, 'MISC', AnInstance); 758 //SetControl(cboCollType, 'COLLECT', AnInstance); 759 //SetControl(cboCollTime, 'START', AnInstance); 760 SetControl(calWantTime, 'DATETIME', AnInstance); 761 //LoadUrgency(cboCollType.ItemID, cboUrgency); 762 SetControl(cboUrgency, 'URGENCY', AnInstance); 763 Urgency := cboUrgency.ItemIEN; 764 if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then 765 begin 766 cboUrgency.ItemIndex := 0; 767 Urgency := cboUrgency.ItemIEN; 768 end; 769 i := 1 ; 770 AResponse := Responses.FindResponseByName('COMMENT',i); 771 while AResponse <> nil do 772 begin 773 if Length(AResponse.Evalue) > 0 then 774 Comment.Add(AResponse.EValue); 775 Inc(i); 776 AResponse := Responses.FindResponseByName('COMMENT',i); 777 end ; 778 end; 779 if sub = 't' then with ALabTest do //DIAGNOSTIC TEST 780 begin 781 Changing := True; 782 DisableComponentControls; 783 EnableDiagTestControls; 784 LRORDERMODE := TORDER_MODE_DIAG; 785 with Responses do 786 begin 787 StatusText('Initializing Order'); 788 AResponse := FindResponseByName('ORDERABLE', AnInstance); 789 if AResponse <> nil then 790 sub1 := GetSubtype(AResponse.EValue); 791 if sub1 = 't' then 792 begin 793 SetControl(cboAvailTest, 'ORDERABLE', AnInstance); 794 //SetControl(cboTests, 'ORDERABLE', AnInstance); 795 //DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START 796 cboAvailTestSelect(self); 797 end; 798 end; 799 Changing := False; 800 if ObtainCollSamp then 801 begin 802 //For BloodBank orders, this condition should never occur 803 end 804 else 805 begin 806 with ALabTest do 807 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do 808 begin 809 x := '' ; 810 for i := 0 to WardComment.Count-1 do 811 x := x + WardComment.strings[i]+#13#10 ; 812 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1; 813 OrderMessage(x) ; 814 end ; 815 end; 816 end; 817 if sub = 'c' then with ALabTest do //COMPONENT 818 begin 819 Changing := True; 820 DisableDiagTestControls; 821 EnableComponentControls; 822 LRORDERMODE := TORDER_MODE_COMP; 823 with Responses do 824 begin 825 StatusText('Initializing Order'); 826 AResponse := FindResponseByName('ORDERABLE', AnInstance); 827 if AResponse <> nil then 828 sub1 := GetSubtype(AResponse.EValue); 829 if sub1 = 'c' then 830 begin 831 SetControl(cboAvailComp, 'ORDERABLE', AnInstance); 832 //SetControl(cboTests, 'ORDERABLE', AnInstance); 833 SetControl(cboModifiers, 'MODIFIER', AnInstance); 834 SetControl(tQuantity, 'QTY', AnInstance); 835 //DetermineCollectionDefaults(Responses); 836 cboAvailCompSelect(self); 837 end; 838 end; 839 Changing := False; 840 end; 841 with ALabTest do 842 begin 843 if ObtainComment then 844 LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment)) 845 else 846 DisableCommentPanels; 847 x := '' ; 848 for i := 0 to CurWardComment.Count-1 do 849 x := x + CurWardComment.strings[i]+#13#10 ; 850 i := IndexOfCollSamp(CollSamp); 851 if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do 852 for i := 0 to WardComment.Count-1 do 853 x := x + WardComment.strings[i]+#13#10 ; 854 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1; 855 if Length(x) > 0 then 856 begin 857 OrderMessage(x) ; 858 end; 859 end; 860 StatusText(''); 861 Changing := True; 862 //if not(FOrderAction = ORDER_EDIT) then DetermineCollectionDefaults(Responses); 863 Changing := False; 864 end; 865 AnInstance := NextInstance('ORDERABLE', AnInstance); 866 end; //while AnInstance - ORDERABLE 867 DisableComponentControls; 868 DisableDiagTestControls; 869 uQuickInProcess := 0; 870 end; } 871 finally 872 aList.Free; 873 aTests.Free; 874 end; 875 edtResults.Height := 247; 876 edtInfo.Height := 247; 877 if lvSelectionList.Items.Count > 0 then 878 begin 879 pnlSelectedTests.Visible := True; 880 cmdAccept.Visible := True; 881 memOrder.Visible := True; 882 GroupBox1.Visible := False; 883 end; 884 end; 885 886 procedure TfrmODBBank.SetOnQuickOrder; 887 var 888 AnInstance: Integer; 889 AResponse: TResponse; 378 890 i: integer; 891 x,sub,sub1,aTNSString: string; 892 aList: TStringList; 893 aGotIt: boolean; 894 aTests: TStringList; 895 ListItem: TListItem; 896 aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aTypeScreen: String; 897 CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS, aTNSDays: Integer; 379 898 begin 380 899 inherited; 381 ReadServerVariables; 382 if LRFZX <> '' then 383 begin 384 cboCollType.SelectByID(LRFZX); 385 if cboCollType.ItemIndex > -1 then SetupCollTimes(LRFZX); 386 end; 387 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do 388 begin 389 SetControl(cboAvailTest, 'ORDERABLE', 1); 390 cboAvailTestSelect(Self); 391 if ALabTest = nil then Exit; // Causes access violation in FillCollSampleList 392 Changing := True; 393 DetermineCollectionDefaults(Responses); 394 i := 1 ; 395 tmpResp := Responses.FindResponseByName('COMMENT',i); 396 while tmpResp <> nil do 397 begin 398 Comment.Add(tmpResp.EValue); 399 Inc(i); 400 tmpResp := Responses.FindResponseByName('COMMENT',i); 401 end ; 402 Changing := False; 403 end; 900 aList := TStringList.Create; 901 aTests := TStringList.Create; 902 try 903 aModifier := ''; 904 aReason := ''; 905 aSurgery := ''; 906 aCollTime := ''; 907 aTestYes := '0'; 908 aTypeScreen := ''; 909 aSpecimen := ''; 910 sub1 := ''; 911 ExtractTypeScreen(aList, uVBECList); 912 if aList.Count > 0 then aTypeScreen := aList[0]; 913 aList.Clear; 914 Extractspecimen(aList, uVBECList); 915 if aList.Count > 0 then aSpecimen := aList[0]; 916 with Responses, ALabTest do 917 begin 918 Changing := True; 919 aGotIt := False; 920 FLastItemID := cboQuick.ItemID; 921 QuickOrder := ExtractInteger(cboQuick.ItemID); 922 with Responses do 923 begin 924 StatusText('Initializing Quick Order'); 925 AnInstance := NextInstance('ORDERABLE', 0); 926 while AnInstance > 0 do 927 begin 928 AResponse := FindResponseByName('ORDERABLE', AnInstance); 929 sub := GetSubtype(AResponse.EValue); 930 if sub = 't' then 931 begin 932 SetControl(cboAvailTest, 'ORDERABLE', AnInstance); 933 ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses); 934 end 935 else 936 begin 937 SetControl(cboAvailComp, 'ORDERABLE', AnInstance); 938 ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses); 939 end; 940 for i := 0 to aList.Count - 1 do 941 if aList[i] = ALabTest.TestName then 942 begin 943 aGotIt := true; 944 break; 945 end; 946 if aGotIt = true then 947 begin 948 aGotIt := false; 949 AnInstance := NextInstance('ORDERABLE', AnInstance); 950 Continue; 951 end 952 else 953 begin 954 aList.Add(ALabTest.TestName); 955 end; 956 if AResponse <> nil then 957 sub1 := GetSubtype(AResponse.EValue); 958 if AnInstance = 1 then 959 begin 960 SetControl(cboReasons, 'REASON', AnInstance); 961 SetControl(calWantTime, 'DATETIME', AnInstance); 962 SetControl(memDiagComment, 'COMMENT', AnInstance); 963 SetControl(chkConsent, 'YN', AnInstance); 964 //DetermineCollectionDefaults(Responses); 965 SetControl(cboCollType, 'COLLECT', AnInstance); 966 SetupCollTimes(cboCollType.ItemID); 967 //SetControl(cboCollTime, 'START', AnInstance); 968 //LoadUrgency(cboCollType.ItemID, cboUrgency); 969 SetControl(cboUrgency, 'URGENCY', AnInstance); 970 Urgency := cboUrgency.ItemIEN; 971 if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then 972 begin 973 cboUrgency.ItemIndex := 0; 974 Urgency := cboUrgency.ItemIEN; 975 cboUrgencyChange(self); 976 end; 977 SetControl(cboSurgery, 'MISC', AnInstance); 978 if not(ALabTest = nil) then 979 begin 980 Urgency := cboUrgency.ItemIEN; 981 if (Urgency = 0) and (cboUrgency.Items.Count = 1) then 982 begin 983 cboUrgency.ItemIndex := 0; 984 Urgency := cboUrgency.ItemIEN; 985 end; 986 i := 1 ; 987 AResponse := Responses.FindResponseByName('COMMENT',i); 988 while AResponse <> nil do 989 begin 990 Comment.Add(AResponse.EValue); 991 Inc(i); 992 AResponse := Responses.FindResponseByName('COMMENT',i); 993 end ; 994 end; 995 if not(cboCollType.ItemID = 'LC') then 996 begin 997 if Length(cboCollTime.Text) > 0 then 998 begin 999 calCollTime.FMDateTime := StrToFMDateTime(cboCollTime.Text); 1000 FLastCollTime := cboCollTime.Text; 1001 end 1002 else 1003 begin 1004 FLastCollTime := ''; 1005 end; 1006 end; 1007 end; 1008 if sub1 = 'c' then 1009 begin 1010 DisableDiagTestControls; 1011 EnableComponentControls; 1012 LRORDERMODE := TORDER_MODE_COMP; 1013 SetControl(cboAvailComp, 'ORDERABLE', AnInstance); 1014 SetControl(cboModifiers, 'MODIFIER', AnInstance); 1015 SetControl(tQuantity, 'QTY', AnInstance); 1016 //DetermineCollectionDefaults(Responses); 1017 //Check for and display any associated Lab Results 1018 aList.Clear; 1019 TestAdded := 0; 1020 getTest := 0; 1021 ExtractTests(aList, uVBECList); //Get Results associated with ordered components 1022 for j := 0 to aList.Count - 1 do 1023 begin 1024 if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then 1025 begin 1026 if uTestsForResults.Count < 1 then getTest := 1; 1027 for k := 0 to uTestsForResults.Count - 1 do 1028 begin 1029 if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then 1030 begin 1031 getTest := 0; 1032 break; 1033 end 1034 else getTest := 1; 1035 end; 1036 if getTest = 1 then 1037 begin 1038 uTestsForResults.Add(piece(aList[j],'^',3)); 1039 TestAdded := 1; 1040 end; 1041 end; 1042 end; 1043 if TestAdded = 1 then 1044 begin 1045 edtResults.Clear; 1046 aTests.Clear; 1047 GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults); 1048 QuickCopy(ATests,edtResults); 1049 if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1; 1050 uRaw.Clear; 1051 GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults); 1052 end; 1053 CurAdd := 1; 1054 if uRaw.Count > 0 then 1055 for j := 0 to uRaw.Count - 1 do 1056 begin 1057 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1)); 1058 Inc(CurAdd); 1059 end; 1060 aSpecimen := '^'; 1061 aTestYes := '0'; 1062 aReason := ''; 1063 aSurgery := ''; 1064 aCollTime := ''; 1065 ExtractSpecimen(aList, uVBECList); 1066 if aList.Count > 0 then aSpecimen := aList[0]; 1067 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex]; 1068 if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex]; 1069 if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex]; 1070 if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; 1071 if Length(cboSurgery.ItemID) > 0 then 1072 begin 1073 aList.Clear; 1074 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey 1075 for i := 0 to aList.Count - 1 do 1076 begin 1077 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) 1078 and (piece(aList[i],'^',3) = cboSurgery.Text) then 1079 begin 1080 aMSBOS := StrToInt(piece(aList[i],'^',4)); 1081 if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then 1082 begin 1083 with Application do 1084 begin 1085 NormalizeTopMosts; 1086 aMSBOSContinue := 1087 MessageBox(PChar('The number of units ordered (' + tQuantity.Text + 1088 ') for ' + aLabTest.TestName + ' exceeds the maximum number of units (' 1089 + IntToStr(aMSBOS) + 1090 ') for the ' + cboSurgery.text + 1091 ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'), 1092 PChar('Maximum Number of Units Exceeded'), 1093 MB_YESNO); 1094 RestoreTopMosts; 1095 end; 1096 if aMSBOSContinue = 7 then 1097 begin 1098 ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.'); 1099 exit; 1100 end; 1101 end; 1102 end; 1103 end; 1104 end; 1105 if (uTNSOrders.Count < 1) then //SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then //check to see if type and screen is needed 1106 begin 1107 uGetTnS := 1; 1108 end; 1109 aList.Clear; 1110 ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server 1111 for i := 0 to aList.Count - 1 do 1112 begin 1113 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then 1114 begin 1115 aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen; 1116 break; 1117 end; 1118 end; 1119 uComponentSelected := true; 1120 with lvSelectionList do 1121 begin 1122 ListItem := Items.Add; 1123 ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2); 1124 ListItem.SubItems.Add(tQuantity.Text); 1125 if length(cboModifiers.ItemID) > 0 then 1126 begin 1127 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); 1128 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); 1129 end 1130 else 1131 begin 1132 ListItem.SubItems.Add(''); 1133 ListItem.SubItems.Add(''); 1134 end; 1135 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); 1136 end; 1137 CurAdd := 1; 1138 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests 1139 uSelectedItems.Add(aStr); 1140 for i := 0 to uSelectedItems.Count - 1 do 1141 begin 1142 aName := lvSelectionList.Items[i].Caption; 1143 x := uSelectedItems[i]; 1144 if piece(x,'^',1) = '1' then //Diagnostic Test related fields 1145 begin 1146 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 1147 end 1148 else 1149 begin 1150 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 1151 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3)); 1152 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier); 1153 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5)); 1154 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 1155 end; 1156 Inc(CurAdd); 1157 end; 1158 memOrder.Text := Responses.OrderText; 1159 GroupBox1.Visible := False; 1160 aMsg := ''; 1161 LRORDERMODE := TORDER_MODE_INFO; 1162 {if uGetTnS = 1 then 1163 begin 1164 lblTNS.Caption := 'TYPE + SCREEN must be added to order'; 1165 lblTNS.Visible := true; 1166 memMessage.Text := 'TYPE + SCREEN must be added to order'; 1167 memMessage.Visible := false; 1168 pnlMessage.Visible := true; 1169 pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; 1170 end; } 1171 {if uGetTnS = 1 then 1172 begin 1173 if responses.QuickOrder < 1 then 1174 begin 1175 for i := 1 to cboAvailTest.Items.Count - 1 do 1176 begin 1177 if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then 1178 begin 1179 if piece(aSpecimen,'^',1) = '1' then 1180 begin 1181 cboCollTime.Text := calWantTime.Text; 1182 aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID; 1183 cboCollTime.Text := ''; 1184 cboCollType.Text := ''; 1185 uSpecimen := 1; 1186 end; 1187 cboModifiers.Text := ''; 1188 cboAvailTest.SelectByID(aTypeScreen); 1189 cboTests.SelectByID(aTypeScreen); 1190 cboTestsClick(self); 1191 //cboAvailTestSelect(Self); 1192 uSpecimen := 0; 1193 cboCollTime.Text := piece(aCollSave,'^',1); 1194 cboCollType.Text := piece(aCollSave,'^',3); 1195 aCollSave := ''; 1196 break; 1197 end; 1198 end; 1199 aMsg := 'An order for Type and Screen has been added to this request' + '.'; 1200 end 1201 else 1202 begin 1203 lblTNS.Caption := 'TYPE + SCREEN must be added to order'; 1204 lblTNS.Visible := true; 1205 memMessage.Text := 'TYPE + SCREEN must be added to order'; 1206 memMessage.Visible := false; 1207 pnlMessage.Visible := true; 1208 end; 1209 end; 1210 if (uGetTnS = 1) then 1211 begin 1212 if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf; 1213 ShowMsg(aMsg); 1214 end; } 1215 1216 //cboModifiers.Text := ''; 1217 edtResults.Height := 247; 1218 edtInfo.Height := 247; 1219 if lvSelectionList.Items.Count > 0 then 1220 begin 1221 pnlSelectedTests.Visible := True; 1222 cmdAccept.Visible := True; 1223 memOrder.Visible := True; 1224 GroupBox1.Visible := False; 1225 end; 1226 end 1227 else 1228 begin 1229 if sub1 = 't' then 1230 begin 1231 DisableComponentControls; 1232 EnableDiagTestControls; 1233 LRORDERMODE := TORDER_MODE_DIAG; 1234 aTestYes := '1'; 1235 SetControl(cboAvailTest, 'ORDERABLE', AnInstance); 1236 //DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START 1237 i := 1 ; 1238 AResponse := Responses.FindResponseByName('COMMENT',i); 1239 while AResponse <> nil do 1240 begin 1241 Comment.Add(AResponse.EValue); 1242 Inc(i); 1243 AResponse := Responses.FindResponseByName('COMMENT',i); 1244 end ; 1245 if ObtainCollSamp then 1246 begin 1247 //For BloodBank orders, this condition should never occur 1248 end 1249 else 1250 begin 1251 with ALabTest do 1252 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do 1253 begin 1254 x := '' ; 1255 for i := 0 to WardComment.Count-1 do 1256 x := x + WardComment.strings[i]+#13#10 ; 1257 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1; 1258 OrderMessage(x) ; 1259 end ; 1260 end; 1261 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 1262 with cboCollType do if Length(ItemID) > 0 then 1263 begin 1264 Responses.Update('COLLECT', 1, ItemID, ItemID) ; 1265 FLastCollType := ItemID; 1266 end; 1267 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text) 1268 else 1269 begin 1270 cboUrgency.ItemIndex := 1; 1271 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 1272 cboUrgencyChange(self); 1273 end; 1274 if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); 1275 if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text); 1276 LoadCollType(cboCollType); 1277 if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then 1278 if not(ALabTest.LabCanCollect) and OrderForInpatient then 1279 cboCollType.SelectByID('WC') 1280 else if not(ALabTest.LabCanCollect) then 1281 cboCollType.SelectByID('SP'); 1282 SetupCollTimes(cboCollType.ItemID); 1283 if cboCollType.ItemID = 'LC' then 1284 begin 1285 with cboCollTime do 1286 if Length(ItemID) > 0 then 1287 begin 1288 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999)); 1289 FLastLabCollTime := ItemID + U + Text; 1290 end 1291 else if Length(Text) > 0 then 1292 begin 1293 Responses.Update('START', 1, ValidCollTime(Text), Text) ; 1294 FLastLabCollTime := ValidCollTime(Text); 1295 end; 1296 end 1297 else 1298 begin 1299 with calCollTime do 1300 if FMDateTime > 0 then 1301 begin 1302 Responses.Update('START', 1, ValidCollTime(Text), Text); 1303 FLastColltime := ValidCollTime(Text); 1304 end 1305 else 1306 begin 1307 Responses.Update('START', 1, '', '') ; 1308 FLastCollTime := ''; 1309 end; 1310 end; 1311 if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; 1312 with cboCollType do if Length(ItemID) > 0 then 1313 begin 1314 Responses.Update('COLLECT', 1, ItemID, ItemID) ; 1315 FLastCollType := ItemID; 1316 end; 1317 uTestSelected := true; 1318 with lvSelectionList do 1319 begin 1320 ListItem := Items.Add; 1321 ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2); 1322 ListItem.SubItems.Add(''); 1323 ListItem.SubItems.Add(''); 1324 ListItem.SubItems.Add(''); 1325 ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1)); 1326 end; 1327 CurAdd := 1; 1328 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces 1329 uSelectedItems.Add(aStr); 1330 for i := 0 to uSelectedItems.Count - 1 do 1331 begin 1332 aName := lvSelectionList.Items[i].Caption; 1333 x := uSelectedItems[i]; 1334 if piece(x,'^',1) = '1' then //Diagnostic Test related fields 1335 begin 1336 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 1337 end; 1338 Inc(CurAdd); 1339 end; 1340 memOrder.Text := Responses.OrderText; 1341 edtResults.Height := 247; 1342 edtInfo.Height := 247; 1343 if lvSelectionList.Items.Count > 0 then 1344 begin 1345 pnlSelectedTests.Visible := True; 1346 cmdAccept.Visible := True; 1347 memOrder.Visible := True; 1348 GroupBox1.Visible := False; 1349 end; 1350 end; 1351 end; 1352 AnInstance := NextInstance('ORDERABLE', AnInstance); 1353 end; 1354 //Quick Order 1355 end; 1356 for i := 0 to lvSelectionList.Items.Count - 1 do 1357 begin 1358 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then 1359 begin 1360 uGetTnS := 0; 1361 uDfltUrgency := cboUrgency.ItemID; 1362 lblTNS.Caption := ''; 1363 lblTNS.Visible := false; 1364 memMessage.Text := ''; 1365 pnlMessage.Visible := false; 1366 pnlDiagnosticTests.Caption := 'Diagnostic Tests'; 1367 if uTNSOrders.Count > 0 then 1368 begin 1369 for j := 0 to uTNSOrders.Count - 1 do 1370 aTNSString := aTNSString + CRLF + uTNSOrders[j]; 1371 with Application do 1372 begin 1373 NormalizeTopMosts; 1374 aTNSDays := TNSDaysBack; 1375 aTNS := 1376 MessageBox(PChar(aTNSString + CRLF + CRLF + 1377 'Do you wish to continue with this request for Type & Screen?'), 1378 PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'), 1379 MB_YESNO); 1380 RestoreTopMosts; 1381 if aTNS = 7 then 1382 begin 1383 lvSelectionList.ItemIndex := i; 1384 lvSelectionListClick(self); 1385 btnRemoveClick(self); 1386 break; 1387 end; 1388 end; 1389 end; 1390 break; 1391 end; 1392 end; 1393 if uGetTnS = 1 then 1394 begin 1395 lblTNS.Caption := 'TYPE + SCREEN must be added to order'; 1396 lblTNS.Visible := true; 1397 memMessage.Text := 'TYPE + SCREEN must be added to order'; 1398 pnlMessage.Visible := true; 1399 pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; 1400 end; 1401 if ALabTest <> nil then 1402 begin 1403 if ObtainCollSamp then 1404 begin 1405 //For BloodBank orders, this condition should never occur 1406 end 1407 else 1408 begin 1409 with ALabTest do 1410 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do 1411 begin 1412 x := '' ; 1413 for i := 0 to WardComment.Count-1 do 1414 x := x + WardComment.strings[i]+#13#10 ; 1415 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1; 1416 OrderMessage(x) ; 1417 end ; 1418 end; 1419 with ALabTest do 1420 begin 1421 if ObtainComment then 1422 LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment)) 1423 else 1424 DisableCommentPanels; 1425 x := '' ; 1426 for i := 0 to CurWardComment.Count-1 do 1427 x := x + CurWardComment.strings[i]+#13#10 ; 1428 i := IndexOfCollSamp(CollSamp); 1429 if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do 1430 for i := 0 to WardComment.Count-1 do 1431 x := x + WardComment.strings[i]+#13#10 ; 1432 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1; 1433 OrderMessage(x) ; 1434 end; 1435 GroupBox1.Visible := False; 1436 end; 1437 StatusText(''); 1438 Changing := False; 1439 end; 1440 finally //**SubTest 1441 alist.Free; 1442 aTests.Free; 1443 end; 404 1444 end; 405 1445 … … 422 1462 LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2); 423 1463 TestReqComment := ExtractDefault(LoadData, 'ReqCom'); 1464 UniqueCollSamp := false; 424 1465 if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True; 425 1466 x := ExtractDefault(LoadData, 'Unique CollSamp'); … … 431 1472 ExtractItems(SpecimenList, LoadData, 'Specimens'); 432 1473 if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC))); 1474 UrgencyList := TStringList.Create; 1475 if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then { forced urgency } 1476 begin 1477 ForceUrgency := True; 1478 UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency')); 1479 Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1)); 1480 uDfltUrgency := Urgency; 1481 end 1482 else 1483 begin { list of urgencies } 1484 ExtractItems(UrgencyList, LoadData, 'Urgencies'); 1485 if StrToIntDef(LRFURG, 0) > 0 then 1486 Urgency := StrToInt(LRFURG) 1487 else 1488 Urgency := uDfltUrgency; 1489 end; 433 1490 Comment := TStringList.Create ; 434 1491 CurWardComment := TStringList.Create; … … 443 1500 OneSamp := TStringList.Create; 444 1501 try 445 OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));1502 FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp); 446 1503 FillCollSampList(OneSamp, CollSampList.Count); 447 1504 finally … … 471 1528 CollSampList.Free; 472 1529 SpecimenList.Free; 1530 UrgencyList.Free; 473 1531 CurWardComment.Free; 474 1532 Comment.Free; … … 631 1689 begin 632 1690 if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ; 633 AComboBox.Items.Assign(SpecimenList);1691 FastAssign(SpecimenList, AComboBox.Items); 634 1692 AComboBox.Items.Add('0^Other...'); 635 1693 with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1); … … 659 1717 end; 660 1718 1719 procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox); 1720 var 1721 i: integer; 1722 begin 1723 if UrgencyList.Count < 1 then Exit; 1724 with AComboBox do 1725 begin 1726 Clear; 1727 for i := 0 to UrgencyList.Count - 1 do 1728 if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then 1729 Continue 1730 else 1731 Items.Add(UrgencyList[i]); 1732 if (LRFURG <> '') and (ALabTest.ObtainUrgency) then 1733 SelectByID(LRFURG) 1734 else 1735 SelectByIEN(uDfltUrgency); 1736 Urgency := AComboBox.ItemIEN; 1737 end; 1738 end; 1739 661 1740 function TLabTest.NameOfCollSamp: string; 662 1741 var … … 683 1762 end; 684 1763 1764 function TLabTest.NameOfUrgency: string; 1765 var 1766 i: Integer; 1767 begin 1768 Result := ''; 1769 with UrgencyList do for i := 0 to Count - 1 do 1770 begin 1771 if StrToInt(Piece(Strings[i], '^', 1)) = Urgency 1772 then Result := Piece(Strings[i], '^', 2); 1773 break; 1774 end; 1775 end; 1776 685 1777 function TLabTest.ObtainCollSamp: Boolean; 686 1778 begin … … 698 1790 end; 699 1791 1792 function TLabTest.ObtainUrgency: Boolean; 1793 begin 1794 Result := not ForceUrgency; 1795 end; 1796 700 1797 function TLabTest.ObtainComment: Boolean; 701 1798 begin … … 708 1805 end; 709 1806 1807 procedure TfrmODBBank.ExtractReasons(OutList:TStrings; AList:TStrings); 1808 begin 1809 ExtractItems(Outlist, AList,'REASONS'); 1810 end; 1811 710 1812 procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings); 711 1813 begin … … 713 1815 end; 714 1816 1817 procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings); 1818 begin 1819 ExtractItems(Outlist, AList,'TNS ORDERS'); 1820 end; 1821 715 1822 procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings); 716 1823 begin … … 726 1833 begin 727 1834 ExtractItems(OutList, AList, 'TYPE AND SCREEN'); 1835 end; 1836 1837 procedure TfrmODBBank.ExtractOther(OutList:TStrings; AList:TStrings); 1838 begin 1839 ExtractItems(OutList, AList, 'OTHER'); 728 1840 end; 729 1841 … … 813 1925 inherited; 814 1926 if uSelectedItems.Count < 1 then 815 SetError(TX_NO_TESTS); 1927 begin 1928 SetError(TX_NO_TESTS); 1929 Exit; 1930 end; 816 1931 if uGetTns = 1 then 817 SetError(TX_TNS_REQUIRED); 1932 begin 1933 SetError(TX_TNS_REQUIRED); 1934 Exit; 1935 end; 1936 ValidateAdd(AnErrMsg); 818 1937 end; 819 1938 … … 827 1946 828 1947 var 829 i, CmtType, DaysofFuturePast: integer; 1948 aList: TStringList; 1949 i, DaysofFuturePast: integer; 830 1950 d1, d2: TDateTime; 831 x : string;1951 x,test,aOther: string; 832 1952 const 833 1953 {Diagnostic Test Errors} 834 TX_NO_TIME = 'Collection Time is required .' ;835 TX_NO_TCOLLTYPE = 'Collection Type is required .' ;836 TX_NO_TESTS = 'A Lab Test or tests must be selected .' ;1954 TX_NO_TIME = 'Collection Time is required' ; 1955 TX_NO_TCOLLTYPE = 'Collection Type is required' ; 1956 TX_NO_TESTS = 'A Lab Test or tests must be selected' ; 837 1957 TX_BAD_TIME = 'Collection times must be chosen from the drop down list or entered as valid' + 838 ' Fileman date/times (T@1700, T+1@0800, etc.) .' ;839 TX_PAST_TIME = 'Collection times in the past are not allowed .';840 TX_NO_DAYS = 'A number of days must be entered for continuous orders .';841 TX_NO_TIMES = 'A number of times must be entered for continuous orders .';842 TX_NO_STOP_DATE = 'Could not calculate the stop date for the order. Check "for n Days" .';1958 ' Fileman date/times (T@1700, T+1@0800, etc.)' ; 1959 TX_PAST_TIME = 'Collection times in the past are not allowed'; 1960 TX_NO_DAYS = 'A number of days must be entered for continuous orders'; 1961 TX_NO_TIMES = 'A number of times must be entered for continuous orders'; 1962 TX_NO_STOP_DATE = 'Could not calculate the stop date for the order. Check "for n Days"'; 843 1963 TX_TOO_MANY_DAYS = 'Maximum number of days allowed is '; 844 1964 TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is: X'; 845 1965 //TX_NO_COMMENT = 'A comment is required for this test and collection sample.'; 846 TX_NUMERIC_REQD = 'A numeric value is required for urine volume .';847 TX_DOSEDRAW_REQD = 'Both DOSE and DRAW times are required for this order .';848 TX_TDM_REQD = 'A value for LEVEL is required for this order .';1966 TX_NUMERIC_REQD = 'A numeric value is required for urine volume'; 1967 TX_DOSEDRAW_REQD = 'Both DOSE and DRAW times are required for this order'; 1968 TX_TDM_REQD = 'A value for LEVEL is required for this order'; 849 1969 //TX_ANTICOAG_REQD = 'You must specify an anticoagulant on this order.' ; 850 TX_NO_COLLSAMPLE = 'A collection sample MUST be specified .';851 TX_NO_SPECIMEN = 'A specimen MUST be specified .';852 TX_NO_URGENCY = 'An urgency MUST be specified .';853 TX_NO_FREQUENCY = 'A collection frequency MUST be specified .';854 TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time .';855 TX_NO_ALPHA = 'For continuous orders, enter a number of days, or an "X" followed by a number of times .';1970 TX_NO_COLLSAMPLE = 'A collection sample MUST be specified'; 1971 TX_NO_SPECIMEN = 'A specimen MUST be specified'; 1972 TX_NO_URGENCY = 'An urgency MUST be specified'; 1973 TX_NO_FREQUENCY = 'A collection frequency MUST be specified'; 1974 TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time'; 1975 TX_NO_ALPHA = 'For continuous orders, enter a number of days, or an "X" followed by a number of times'; 856 1976 TX_BADTIME_CAP = 'Invalid Immediate Collect Time'; 857 1977 {Component/Type & Screen Errors} 858 TX_NO_COMPONENTS = 'A Blood Product MUST be selected .';859 TX_NO_QUANTITY = 'The number of units MUST be specified under "Quantity" .';860 TX_HIGH_QUANTITY = 'Quantity too high .';1978 TX_NO_COMPONENTS = 'A Blood Product MUST be selected'; 1979 TX_NO_QUANTITY = 'The number of units MUST be specified under "Quantity"'; 1980 TX_HIGH_QUANTITY = 'Quantity too high'; 861 1981 TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified'; 862 //TX_NO_PREPARATION = 'Preparation MUST be specified - either "Hold" or "Immediate".';863 1982 TX_NO_SURGERY = 'A Surgery MUST be specified for Pre-Op orders'; //only if Pre-op selected 864 1983 TX_NO_REASON = 'A Reason for Request MUST be entered'; 1984 TX_REASON_TOO_LONG= 'Reason for Request MUST be less than 76 characters long'; 1985 TX_MODIFIER_TOO_LONG = 'Modifer text MUST be less than 51 characters long'; 865 1986 TX_NO_COMMENT = 'A Comment MUST be entered for this Component'; 866 1987 TX_DUPLICATE = 'Duplicate Test/Component not allowed'; … … 870 1991 inherited; 871 1992 AnErrMsg := ''; 872 if aLabTest = nil then 873 begin 874 AnErrMsg := TX_NO_TEST_SELECTED; 875 Exit; 876 end; 877 for i := 0 to uSelectedItems.Count - 1 do 878 if IntToStr(aLabTest.TestID) = piece(uSelectedItems[i],'^',2) then 1993 aList := TStringList.Create; 1994 try 1995 ExtractOther(aList, uVBECList); 1996 if aList.Count > 0 then aOther := aList[0]; 1997 aList.Clear; 1998 if uSelectedItems.Count < 1 then 879 1999 begin 880 AnErrMsg := TX_ DUPLICATE;2000 AnErrMsg := TX_NO_TEST_SELECTED; 881 2001 Exit; 882 2002 end; 883 if LRORDERMODE = TORDER_MODE_DIAG then 884 begin 885 with cboAvailTest do if ItemIEN <= 0 then SetError(TX_NO_TESTS); 886 887 if ALabTest <> nil then 888 if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then 2003 for i := 0 to uSelectedItems.Count - 1 do 2004 begin 2005 x := uSelectedItems[i]; 2006 test := lvSelectionList.Items[i].Caption; 2007 if piece(x,'^',1) = '1' then //Diagnostic Test 889 2008 begin 890 SetError(TX_NO_IMMED); 891 cboCollType.ItemIndex := -1; 2009 if uSpecimen = 0 then 2010 if cboCollType.ItemID = '' then 2011 SetError(TX_NO_TCOLLTYPE + ' (' + test + ')') 2012 else if cboCollType.ItemID = 'LC' then 2013 begin 2014 if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME + ' (' + test + ')'); 2015 with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then 2016 begin 2017 if StrToFMDateTime(Text) < 0 then 2018 SetError(TX_BAD_TIME + ' (' + test + ')') 2019 else if StrToFMDateTime(Text) < FMNow then 2020 SetError(TX_PAST_TIME + ' (' + test + ')') 2021 else if OrderForInpatient then 2022 begin 2023 d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text))); 2024 d2 := FMDateTimeToDateTime(FMToday); 2025 if EvtDelayLoc > 0 then 2026 DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision) 2027 else 2028 DaysofFuturePast := LabCollectFutureDays(Encounter.Location); 2029 if DaysofFuturePast = 0 then DaysofFuturePast := 7; 2030 if ((d1 - d2) > DaysofFuturePast) then 2031 SetError('A lab collection cannot be ordered more than ' 2032 + IntToStr(DaysofFuturePast) + ' days in advance'); 2033 end 2034 else if EvtDelayLoc > 0 then 2035 begin 2036 if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then 2037 SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')'); 2038 end 2039 else if EvtDelayLoc <= 0 then 2040 begin 2041 if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then 2042 SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')'); 2043 end; 2044 end; 2045 end 2046 else 2047 begin 2048 if cboCollType.ItemID = 'I' then 2049 begin 2050 calCollTime.Text := txtImmedColl.Text; 2051 x := ValidImmCollTime(calCollTime.FMDateTime); 2052 if (Piece(x, U, 1) <> '1') then 2053 SetError(Piece(x, U, 2)); 2054 end; 2055 2056 with calColltime do 2057 begin 2058 if FMDateTime = 0 then SetError(TX_BAD_TIME + ' (' + test + ')') 2059 else 2060 begin 2061 // date only was entered 2062 if (FMDateTime - Trunc(FMDateTime) = 0) then 2063 begin 2064 if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME + ' (' + test + ')'); 2065 end 2066 // date/time was entered 2067 else 2068 begin 2069 if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME + ' (' + test + ')'); 2070 end; 2071 end; 2072 end; 2073 end; 2074 2075 with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY + ' (' + test + ')'); 2076 end 2077 else //Component 2078 begin 2079 if piece(x,'^',3) ='' then SetError(TX_NO_QUANTITY + ' (' + test + ')') 2080 else 2081 begin 2082 if StrToInt(piece(x,'^',3)) < 1 then SetError(TX_NO_QUANTITY + ' (' + test + ')'); 2083 if StrToInt(piece(x,'^',3)) > 100 then SetError(TX_HIGH_QUANTITY + ' (' + test + ')'); 2084 end; 2085 if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED + ' (' + test + ')'); 2086 if (cboReasons.Text = '') and not(uReason = '') then 2087 begin 2088 SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.'); 2089 cboReasons.Text := uReason; //reset reason back to previous value 2090 end; 2091 if (cboReasons.Text = '') then 2092 begin 2093 SetError(TX_NO_REASON + ' (' + test + ').'); 2094 end; 2095 if (memDiagComment.Text = '') and (piece(x,'^',2) = aOther) then SetError(TX_NO_COMMENT + ' (' + test + ')'); 2096 if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.Text) < 1) then SetError(TX_NO_SURGERY + ' (' + test + ')'); 2097 if (length(cboReasons.Text) > 75) then SetError(TX_REASON_TOO_LONG); 2098 if (length(cboModifiers.Text) > 50) then SetError(TX_MODIFIER_TOO_LONG); 892 2099 end; 893 if uSpecimen = 0 then 894 if cboCollType.ItemID = '' then 895 SetError(TX_NO_TCOLLTYPE) 896 else if cboCollType.ItemID = 'LC' then 897 begin 898 if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME); 899 with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then 900 begin 901 if StrToFMDateTime(Text) < 0 then 902 SetError(TX_BAD_TIME) 903 else if StrToFMDateTime(Text) < FMNow then 904 SetError(TX_PAST_TIME) 905 else if OrderForInpatient then 906 begin 907 d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text))); 908 d2 := FMDateTimeToDateTime(FMToday); 909 if EvtDelayLoc > 0 then 910 DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision) 911 else 912 DaysofFuturePast := LabCollectFutureDays(Encounter.Location); 913 if DaysofFuturePast = 0 then DaysofFuturePast := 7; 914 if ((d1 - d2) > DaysofFuturePast) then 915 SetError('A lab collection cannot be ordered more than ' 916 + IntToStr(DaysofFuturePast) + ' days in advance'); 917 end 918 else if EvtDelayLoc > 0 then 919 begin 920 if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then 921 SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME); 922 end 923 else if EvtDelayLoc <= 0 then 924 begin 925 if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then 926 SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME); 927 end; 928 end; 929 end 930 else 931 begin 932 if cboCollType.ItemID = 'I' then 933 begin 934 calCollTime.Text := txtImmedColl.Text; 935 x := ValidImmCollTime(calCollTime.FMDateTime); 936 if (Piece(x, U, 1) <> '1') then 937 SetError(Piece(x, U, 2)); 938 end; 939 940 with calColltime do 941 begin 942 if FMDateTime = 0 then SetError(TX_BAD_TIME) 943 else 944 begin 945 // date only was entered 946 if (FMDateTime - Trunc(FMDateTime) = 0) then 947 begin 948 if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME); 949 end 950 // date/time was entered 951 else 952 begin 953 if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME); 954 end; 955 end; 956 end; 957 end; 958 959 with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY); 960 if ALabTest <> nil then 961 begin 962 CmtType := FCmtTypes.IndexOf(ALabTest.CurReqComment) ; 963 with ALabTest do 964 case CmtType of 965 0 : {ANTICOAGULATION} {if (Pos('ANTICOAGULANT',Comment.Text)=0) then 966 SetError(TX_ANTICOAG_REQD)}; 967 1 : {DOSE/DRAW TIMES} if (Pos('Last dose:',Comment.Text)=0) or 968 (Pos('draw time:',Comment.Text)=0) then 969 SetError(TX_DOSEDRAW_REQD); 970 2 : {ORDER COMMENT} {if (Length(Comment.Text)=0) then 971 SetError(TX_NO_COMMENT)}; 972 3 : {ORDER COMMENT MODIFIED} {if (Length(Comment.Text)=0) then 973 SetError(TX_NO_COMMENT)}; 974 4 : {TDM (PEAK-TROUGH} if (Pos('Dose is expected',Comment.Text)=0) then 975 SetError(TX_TDM_REQD); 976 5 : {TRANSFUSION} {if (Length(Comment.Text)=0) then 977 SetError(TX_NO_COMMENT)}; 978 6 : {URINE VOLUME} if (Length(Comment.Text)>0) and 979 (ExtractInteger(Comment.Text)<=0) then 980 Comment.Text := '?'; 981 {SetError(TX_NUMERIC_REQD);} 982 end; 983 end; 984 end 985 else if LRORDERMODE = TORDER_MODE_COMP then 986 begin 987 with cboAvailComp do 988 begin 989 if ItemIEN <= 0 then SetError(TX_NO_COMPONENTS); 990 end; 991 if StrToInt(tQuantity.Text) < 1 then SetError(TX_NO_QUANTITY); 992 if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED); 993 //if cboPreparation.Text ='' then SetError(TX_NO_PREPARATION); 994 if StrToInt(tQuantity.Text) > 100 then SetError(TX_HIGH_QUANTITY); 995 if tReason.Text = '' then SetError(TX_NO_REASON); 996 if (txtDiagComment.Text = '') and (cboAvailComp.Text = 'OTHER') then SetError(TX_NO_COMMENT); 997 if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.ItemID) < 1) then SetError(TX_NO_SURGERY); 998 end; 2100 end; 2101 finally 2102 aList.Free; 2103 end; 999 2104 end; 1000 2105 … … 1273 2378 end; 1274 2379 2380 procedure TfrmODBBank.cboQuickClick(Sender: TObject); 2381 begin 2382 inherited; 2383 SetOnQuickOrder; 2384 end; 2385 2386 procedure TfrmODBBank.cboReasonsChange(Sender: TObject); 2387 begin 2388 inherited; 2389 if (length(cboReasons.Text) > 75) then 2390 begin 2391 ShowMsg('REASON FOR REQUEST cannot be longer than 75 characters'); 2392 cboReasons.Text := Copy(cboReasons.Text,0,75); 2393 Exit; 2394 end; 2395 if Length(cboReasons.Text) > 0 then Responses.Update('REASON', 1, cboReasons.Text, cboReasons.Text); 2396 memOrder.Text := Responses.OrderText; 2397 end; 2398 2399 procedure TfrmODBBank.cboReasonsEnter(Sender: TObject); 2400 begin 2401 inherited; 2402 if Length(cboReasons.Text) > 0 then 2403 uReason := cboReasons.Text; 2404 end; 2405 2406 procedure TfrmODBBank.cboReasonsExit(Sender: TObject); 2407 begin 2408 inherited; 2409 if Length(cboReasons.Text) > 0 then 2410 uReason := cboReasons.Text; 2411 end; 2412 1275 2413 procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject); 1276 2414 var 1277 x: string;1278 2415 i: integer; 1279 begin 1280 DisableComponentControls; 1281 EnableDiagTestControls; 1282 LRORDERMODE := TORDER_MODE_DIAG; 1283 with cboAvailTest do 1284 begin 1285 if (Length(ItemID) = 0) or (ItemID = '0') then Exit; 2416 text : string; 2417 ListItem: TListItem; 2418 aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aTestYes,x,aName,aTNSString: string; 2419 aList: TStringList; 2420 curAdd,AnInstance,aTNS,aTNSDays: Integer; 2421 sub,sub1: string; 2422 AResponse: TResponse; 2423 begin 2424 if cboAvailTest.ItemID = '' then Exit; 2425 aList := TStringList.Create; 2426 try 2427 ALabTest := nil; 2428 aTypeScreen := ''; 2429 aSpecimen := '^'; 2430 aTestYes := '1'; 2431 aModifier := ''; 2432 changing := true; 2433 tQuantity.Text := ''; 2434 sub1 := ''; 2435 cboModifiers.ItemIndex := -1; 2436 DisableComponentControls; 2437 EnableDiagTestControls; 2438 LRORDERMODE := TORDER_MODE_DIAG; 2439 ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses); 2440 sub := GetSubtype(ALabTest.TestName); 2441 with CtrlInits do 2442 begin 2443 SetControl(cboCollType, 'Collection Types'); 2444 LoadCollType(cboCollType); 2445 if FLastCollType <> '' then 2446 cboCollType.SelectByID(FLastCollType) 2447 else if uDfltCollType <> '' then 2448 cboCollType.SelectByID(uDfltCollType) 2449 else if OrderForInpatient then 2450 if (ALabTest.LabCanCollect) then 2451 cboCollType.SelectByID('LC') 2452 else 2453 cboCollType.SelectByID('WC') 2454 else 2455 cboCollType.SelectByID('SP'); 2456 SetupCollTimes(cboCollType.ItemID); 2457 end; 2458 with cboAvailTest do 2459 begin 2460 if (Length(ItemID) = 0) or (ItemID = '0') then Exit; 2461 FLastLabID := ItemID ; 2462 FLastItemID := ItemID; 2463 for i := 0 to uSelectedItems.Count - 1 do 2464 if ItemID = piece(uSelectedItems[i],'^',2) then 2465 begin 2466 ItemIndex := -1; 2467 lvSelectionList.Items[i].Selected := true; 2468 lvSelectionListClick(self); 2469 Exit; 2470 end; 2471 Changing := True; 2472 Changing := False; 2473 ExtractTypeScreen(aList, uVBECList); 2474 if aList.Count > 0 then aTypeScreen := aList[0]; 2475 aList.Clear; 2476 aTNSString := ''; 2477 if (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then 2478 begin 2479 for i := 0 to uTNSOrders.Count - 1 do 2480 aTNSString := aTNSString + CRLF + uTNSOrders[i]; 2481 with Application do 2482 begin 2483 NormalizeTopMosts; 2484 aTNSDays := TNSDaysBack; 2485 aTNS := 2486 MessageBox(PChar(aTNSString + CRLF + CRLF + 2487 'Do you wish to continue?'), 2488 PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'), 2489 MB_YESNO); 2490 RestoreTopMosts; 2491 if aTNS = 7 then 2492 begin 2493 cboAvailTest.ItemIndex := -1; 2494 exit; 2495 end; 2496 end; 2497 end; 2498 if sub = 't' then with ALabTest do //DIAGNOSTIC TEST 2499 begin 2500 if ObtainCollSamp then 2501 begin 2502 //For BloodBank orders, this condition should never occur 2503 end 2504 else 2505 begin 2506 with ALabTest do 2507 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do 2508 begin 2509 x := '' ; 2510 for i := 0 to WardComment.Count-1 do 2511 x := x + WardComment.strings[i]+#13#10 ; 2512 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1; 2513 OrderMessage(x) ; 2514 end ; 2515 end; 2516 end; 2517 Changing := False; 2518 end; 2519 if LRORDERMODE = TORDER_MODE_DIAG then 2520 begin 2521 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 2522 with cboCollType do if Length(ItemID) > 0 then 2523 begin 2524 Responses.Update('COLLECT', 1, ItemID, ItemID) ; 2525 FLastCollType := ItemID; 2526 end; 2527 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text) 2528 else 2529 begin 2530 cboUrgency.ItemIndex := 1; 2531 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 2532 end; 2533 if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); 2534 if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text); 2535 if cboCollType.ItemID = 'LC' then 2536 begin 2537 with cboCollTime do 2538 if Length(ItemID) > 0 then 2539 begin 2540 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999)); 2541 FLastLabCollTime := ItemID + U + Text; 2542 end 2543 else if Length(Text) > 0 then 2544 begin 2545 Responses.Update('START', 1, ValidCollTime(Text), Text) ; 2546 FLastLabCollTime := ValidCollTime(Text); 2547 end; 2548 end 2549 else 2550 begin 2551 with calCollTime do 2552 if FMDateTime > 0 then 2553 begin 2554 Responses.Update('START', 1, ValidCollTime(Text), Text); 2555 FLastColltime := ValidCollTime(Text); 2556 end 2557 else 2558 begin 2559 Responses.Update('START', 1, '', '') ; 2560 FLastCollTime := ''; 2561 end; 2562 end; 2563 if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID); 2564 end; 2565 if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; 2566 uTestSelected := true; 2567 with lvSelectionList do 2568 begin 2569 ListItem := Items.Add; 2570 ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2); 2571 ListItem.SubItems.Add(''); 2572 ListItem.SubItems.Add(''); 2573 ListItem.SubItems.Add(''); 2574 ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1)); 2575 if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then 2576 begin 2577 lblTNS.Caption := ''; 2578 lblTNS.Visible := false; 2579 memMessage.Text := ''; 2580 pnlMessage.Visible := false; 2581 uGetTnS := 0; 2582 pnlDiagnosticTests.Caption := 'Diagnostic Tests'; 2583 end; 2584 end; 2585 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces 2586 uSelectedItems.Add(aStr); 2587 CurAdd := 1; 2588 for i := 0 to uSelectedItems.Count - 1 do 2589 begin 2590 aName := lvSelectionList.Items[i].Caption; 2591 x := uSelectedItems[i]; 2592 if piece(x,'^',1) = '1' then //Diagnostic Test related fields 2593 begin 2594 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 2595 end; 2596 Inc(CurAdd); 2597 end; 2598 memOrder.Text := Responses.OrderText; 2599 finally 2600 aList.Free; 2601 end; 2602 edtResults.Height := 247; 2603 edtInfo.Height := 247; 2604 if lvSelectionList.Items.Count > 0 then 2605 begin 2606 pnlSelectedTests.Visible := True; 2607 cmdAccept.Visible := True; 2608 memOrder.Visible := True; 2609 GroupBox1.Visible := False; 2610 end; 2611 end; 2612 2613 procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject); 2614 var 2615 aList,aTests: TStringList; 2616 i,j,k,getTest,TestAdded: integer; 2617 text : string; 2618 aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer; 2619 sub,sub1: string; 2620 AResponse: TResponse; 2621 ListItem: TListItem; 2622 aTypeScreen,aSpecimen,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName: String; 2623 begin 2624 if cboAvailComp.ItemID = '' then Exit; 2625 aList := TStringList.Create; 2626 aTests := TStringList.Create; 2627 sub1 := ''; 2628 try 2629 DisableDiagTestControls; 2630 EnableComponentControls; 2631 if not(changing = true) then 2632 begin 2633 changing := true; 2634 tQuantity.Text := ''; 2635 cboModifiers.ItemIndex := -1; 2636 changing := false; 2637 end; 2638 LRORDERMODE := TORDER_MODE_COMP; 2639 with cboAvailComp do 2640 begin 2641 if (Length(ItemID) = 0) or (ItemID = '0') then Exit; 2642 FLastLabID := ItemID ; 2643 FLastItemID := ItemID; 2644 for i := 0 to uSelectedItems.Count - 1 do 2645 if ItemID = piece(uSelectedItems[i],'^',2) then 2646 begin 2647 ItemIndex := -1; 2648 lvSelectionList.Items[i].Selected := true; 2649 lvSelectionListClick(self); 2650 Exit; 2651 end; 2652 ALabTest := TLabTest.Create(ItemID, Responses); 2653 sub := GetSubtype(ALabTest.TestName); 2654 Changing := False; 2655 StatusText(''); 2656 end; 2657 //Check for and display any associated Lab Results 2658 aList.Clear; 2659 TestAdded := 0; 2660 getTest := 0; 2661 ExtractTests(aList, uVBECList); //Get Results associated with ordered components 2662 for j := 0 to aList.Count - 1 do 2663 begin 2664 if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then 2665 begin 2666 if uTestsForResults.Count < 1 then getTest := 1; 2667 for k := 0 to uTestsForResults.Count - 1 do 2668 begin 2669 if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then 2670 begin 2671 getTest := 0; 2672 break; 2673 end 2674 else getTest := 1; 2675 end; 2676 if getTest = 1 then 2677 begin 2678 uTestsForResults.Add(piece(aList[j],'^',3)); 2679 TestAdded := 1; 2680 end; 2681 end; 2682 end; 2683 if TestAdded = 1 then 2684 begin 2685 edtResults.Clear; 2686 aTests.Clear; 2687 GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults); 2688 QuickCopy(ATests,edtResults); 2689 if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; 2690 uRaw.Clear; 2691 GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults); 2692 end; 2693 CurAdd := 1; 2694 if uRaw.Count > 0 then 2695 for j := 0 to uRaw.Count - 1 do 2696 begin 2697 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1)); 2698 Inc(CurAdd); 2699 end; 2700 aTypeScreen := ''; 2701 aSpecimen := '^'; 2702 aTestYes := '0'; 2703 aReason := ''; 2704 aSurgery := ''; 2705 aCollTime := ''; 2706 aList.Clear; 2707 ExtractTypeScreen(aList, uVBECList); 2708 if aList.Count > 0 then aTypeScreen := aList[0]; 2709 aList.Clear; 2710 ExtractSpecimen(aList, uVBECList); 2711 if aList.Count > 0 then aSpecimen := aList[0]; 2712 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex]; 2713 if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex]; 2714 if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex]; 2715 if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; 2716 if Length(cboSurgery.ItemID) > 0 then 2717 begin 2718 aList.Clear; 2719 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey 2720 for i := 0 to aList.Count - 1 do 2721 begin 2722 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) 2723 and (piece(aList[i],'^',3) = cboSurgery.Text) then 2724 begin 2725 aMSBOS := StrToInt(piece(aList[i],'^',4)); 2726 if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then 2727 begin 2728 with Application do 2729 begin 2730 NormalizeTopMosts; 2731 aMSBOSContinue := 2732 MessageBox(PChar('The number of units ordered (' + tQuantity.Text + 2733 ') for ' + aLabTest.TestName + ' exceeds the maximum number of units (' 2734 + IntToStr(aMSBOS) + 2735 ') for the ' + cboSurgery.text + 2736 ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'), 2737 PChar('Maximum Number of Units Exceeded'), 2738 MB_YESNO); 2739 RestoreTopMosts; 2740 end; 2741 if aMSBOSContinue = 7 then 2742 begin 2743 ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.'); 2744 exit; 2745 end; 2746 end; 2747 end; 2748 end; 2749 end; 2750 if (uTNSOrders.Count < 1) then // SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then //check to see if type and screen is needed 2751 begin 2752 uGetTnS := 1; 2753 for i := 0 to lvSelectionList.Items.Count - 1 do 2754 begin 2755 if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then 2756 begin 2757 uGetTnS := 0; 2758 if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID; 2759 lblTNS.Caption := ''; 2760 lblTNS.Visible := false; 2761 memMessage.Text := ''; 2762 pnlMessage.Visible := false; 2763 pnlDiagnosticTests.Caption := 'Diagnostic Tests'; 2764 break; 2765 end; 2766 end; 2767 end; 2768 aList.Clear; 2769 ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server 2770 for i := 0 to aList.Count - 1 do 2771 begin 2772 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then 2773 begin 2774 aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen; 2775 break; 2776 end; 2777 end; 2778 uComponentSelected := true; 2779 with lvSelectionList do 2780 begin 2781 ListItem := Items.Add; 2782 ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2); 2783 ListItem.SubItems.Add(tQuantity.Text); 2784 if length(cboModifiers.ItemID) > 0 then 2785 begin 2786 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); 2787 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); 2788 end 2789 else 2790 begin 2791 ListItem.SubItems.Add(''); 2792 ListItem.SubItems.Add(''); 2793 end; 2794 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); 2795 end; 2796 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests 2797 uSelectedItems.Add(aStr); 2798 CurAdd := 1; 1286 2799 for i := 0 to uSelectedItems.Count - 1 do 1287 if ItemID = piece(uSelectedItems[i],'^',1) then 2800 begin 2801 aName := lvSelectionList.Items[i].Caption; 2802 x := uSelectedItems[i]; 2803 if piece(x,'^',1) = '1' then //Diagnostic Test related fields 2804 begin 2805 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 2806 end 2807 else 2808 begin 2809 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 2810 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3)); 2811 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4)); 2812 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5)); 2813 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 2814 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 2815 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text) 2816 else 2817 begin 2818 cboUrgency.ItemIndex := 1; 2819 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 2820 end; 2821 end; 2822 Inc(CurAdd); 2823 end; 2824 memOrder.Text := Responses.OrderText; 2825 finally 2826 alist.Free; 2827 aTests.Free; 2828 end; 2829 aMsg := ''; 2830 LRORDERMODE := TORDER_MODE_INFO; 2831 if uGetTnS = 1 then 2832 begin 2833 lblTNS.Caption := 'TYPE + SCREEN must be added to order'; 2834 lblTNS.Visible := true; 2835 memMessage.Text := 'TYPE + SCREEN must be added to order'; 2836 pnlMessage.Visible := true; 2837 pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; 2838 end; 2839 {if uGetTnS = 1 then 2840 begin 2841 if responses.QuickOrder < 1 then 2842 begin 2843 for i := 1 to cboAvailTest.Items.Count - 1 do 2844 begin 2845 if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then 2846 begin 2847 if piece(aSpecimen,'^',1) = '1' then 2848 begin 2849 cboCollTime.Text := calWantTime.Text; 2850 aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID; 2851 cboCollTime.Text := ''; 2852 cboCollType.Text := ''; 2853 uSpecimen := 1; 2854 end; 2855 cboModifiers.Text := ''; 2856 cboAvailTest.SelectByID(aTypeScreen); 2857 cboTests.SelectByID(aTypeScreen); 2858 cboTestsClick(self); 2859 //cboAvailTestSelect(Self); 2860 uSpecimen := 0; 2861 cboCollTime.Text := piece(aCollSave,'^',1); 2862 cboCollType.Text := piece(aCollSave,'^',3); 2863 aCollSave := ''; 2864 break; 2865 end; 2866 end; 2867 aMsg := 'An order for Type and Screen has been added to this request' + '.'; 2868 end 2869 else 1288 2870 begin 1289 ShowMessage('This test has already been selected!'); 1290 Exit; 2871 lblTNS.Caption := 'TYPE + SCREEN must be added to order'; 2872 lblTNS.Visible := true; 2873 memMessage.Text := 'TYPE + SCREEN must be added to order'; 2874 memMessage.Visible := false; 2875 pnlMessage.Visible := true; 1291 2876 end; 1292 FLastLabID := ItemID ; 1293 FLastItemID := ItemID; 1294 Changing := True; 1295 if Sender <> Self then 1296 Responses.Clear; // Sender=Self when called from SetupDialog 1297 if CharAt(ItemID, 1) = 'Q' then 1298 with Responses do 1299 begin 1300 FLastItemID := ItemID; 1301 QuickOrder := ExtractInteger(ItemID); 1302 SetControl(cboAvailTest, 'ORDERABLE', 1); 1303 if (Length(ItemID) = 0) or (ItemID = '0') then Exit; 1304 FLastLabID := ItemID; 1305 end; 1306 ALabTest := TLabTest.Create(ItemID, Responses); 1307 end; 1308 with ALabTest do 1309 begin 1310 1311 {with Responses do if QuickOrder > 0 then 1312 begin 1313 StatusText('Initializing Quick Order'); 1314 Changing := True; 1315 SetControl(cboAvailTest, 'ORDERABLE', 1); 1316 DetermineCollectionDefaults(Responses); 1317 LoadUrgency(cboCollType.ItemID, cboUrgency); 1318 SetControl(cboUrgency, 'URGENCY', 1); 1319 Urgency := cboUrgency.ItemIEN; 1320 if (Urgency = 0) and (cboUrgency.Items.Count = 1) then 1321 begin 1322 cboUrgency.ItemIndex := 0; 1323 Urgency := cboUrgency.ItemIEN; 1324 end; 1325 tmpResp := FindResponseByName('SPECIMEN' ,1); 1326 i := 1 ; 1327 tmpResp := Responses.FindResponseByName('COMMENT',i); 1328 while tmpResp <> nil do 1329 begin 1330 Comment.Add(tmpResp.EValue); 1331 Inc(i); 1332 tmpResp := Responses.FindResponseByName('COMMENT',i); 1333 end ; 1334 end; // Quick Order} 1335 if ObtainCollSamp then 1336 begin 1337 //For BloodBank orders, this condition should never occur 1338 end 2877 end; 2878 if (uGetTnS = 1) then 2879 begin 2880 if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf; 2881 ShowMsg(aMsg); 2882 end; } 2883 edtResults.Height := 247; 2884 edtInfo.Height := 247; 2885 if lvSelectionList.Items.Count > 0 then 2886 begin 2887 pnlSelectedTests.Visible := True; 2888 cmdAccept.Visible := True; 2889 memOrder.Visible := True; 2890 GroupBox1.Visible := False; 2891 end; 2892 if tQuantity.CanFocus = true then tQuantity.SetFocus; 2893 end; 2894 2895 procedure TfrmODBBank.DisableCommentPanels; 2896 begin 2897 lblReqComment.Visible := False; 2898 end; 2899 2900 procedure TfrmODBBank.DisableComponentControls; 2901 begin 2902 lblQuantity.Enabled := false; 2903 tQuantity.Enabled := false; 2904 lblModifiers.Enabled := false; 2905 cboModifiers.Enabled := false; 2906 cboAvailComp.ItemIndex := -1; 2907 end; 2908 2909 procedure TfrmODBBank.EnableComponentControls; 2910 begin 2911 lblQuantity.Enabled := true; 2912 tQuantity.Enabled := true; 2913 lblModifiers.Enabled := true; 2914 cboModifiers.Enabled := true; 2915 if not(changing) then 2916 if not(uSelUrgency = 'PRE-OP') then 2917 if uSelUrgency = '' then 2918 if lvSelectionList.Items.Count < 1 then 2919 cboUrgency.SelectByID(IntToStr(uDfltUrgency)); 2920 if cboUrgency.Text = 'PRE-OP' then 2921 begin 2922 lblSurgery.Enabled := true; 2923 cboSurgery.Enabled := true; 2924 lblSurgery.Caption := 'Surgery*'; 2925 end 1339 2926 else 1340 2927 begin 1341 with ALabTest do 1342 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do 1343 begin 1344 x := '' ; 1345 for i := 0 to WardComment.Count-1 do 1346 x := x + WardComment.strings[i]+#13#10 ; 1347 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1; 1348 OrderMessage(x) ; 1349 end ; 2928 lblSurgery.Enabled := false; 2929 cboSurgery.Enabled := false; 2930 lblSurgery.Caption := 'Surgery'; 1350 2931 end; 1351 if ObtainComment then1352 LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))1353 else1354 DisableCommentPanels;1355 x := '' ;1356 for i := 0 to CurWardComment.Count-1 do1357 x := x + CurWardComment.strings[i]+#13#10 ;1358 i := IndexOfCollSamp(CollSamp);1359 if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do1360 for i := 0 to WardComment.Count-1 do1361 x := x + WardComment.strings[i]+#13#10 ;1362 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;1363 OrderMessage(x) ;1364 end; { with }1365 StatusText('');1366 Changing := False;1367 end;1368 1369 procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);1370 var1371 x: string;1372 i: integer;1373 begin1374 DisableDiagTestControls;1375 EnableComponentControls;1376 LRORDERMODE := TORDER_MODE_COMP;1377 with cboAvailComp do1378 begin1379 if (Length(ItemID) = 0) or (ItemID = '0') then Exit;1380 for i := 0 to uSelectedItems.Count - 1 do1381 if ItemID = piece(uSelectedItems[i],'^',1) then1382 begin1383 ShowMessage('This component has already been selected!');1384 Exit;1385 end;1386 FLastLabID := ItemID ;1387 FLastItemID := ItemID;1388 Changing := True;1389 if Sender <> Self then1390 Responses.Clear; // Sender=Self when called from SetupDialog1391 if CharAt(ItemID, 1) = 'Q' then1392 with Responses do1393 begin1394 FLastItemID := ItemID;1395 QuickOrder := ExtractInteger(ItemID);1396 SetControl(cboAvailComp, 'ORDERABLE', 1);1397 if (Length(ItemID) = 0) or (ItemID = '0') then Exit;1398 FLastLabID := ItemID;1399 end;1400 ALabTest := TLabTest.Create(ItemID, Responses);1401 end;1402 with ALabTest do1403 begin1404 1405 {with Responses do if QuickOrder > 0 then1406 begin1407 StatusText('Initializing Quick Order');1408 Changing := True;1409 SetControl(cboAvailTest, 'ORDERABLE', 1);1410 DetermineCollectionDefaults(Responses);1411 LoadUrgency(cboCollType.ItemID, cboUrgency);1412 SetControl(cboUrgency, 'URGENCY', 1);1413 Urgency := cboUrgency.ItemIEN;1414 if (Urgency = 0) and (cboUrgency.Items.Count = 1) then1415 begin1416 cboUrgency.ItemIndex := 0;1417 Urgency := cboUrgency.ItemIEN;1418 end;1419 tmpResp := FindResponseByName('SPECIMEN' ,1);1420 i := 1 ;1421 tmpResp := Responses.FindResponseByName('COMMENT',i);1422 while tmpResp <> nil do1423 begin1424 Comment.Add(tmpResp.EValue);1425 Inc(i);1426 tmpResp := Responses.FindResponseByName('COMMENT',i);1427 end ;1428 end; // Quick Order}1429 {if ObtainCollSamp then1430 begin1431 // should not occur with Blood orders1432 end1433 else1434 begin1435 with ALabTest do1436 with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do1437 begin1438 x := '' ;1439 for i := 0 to WardComment.Count-1 do1440 x := x + WardComment.strings[i]+#13#10 ;1441 pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;1442 OrderMessage(x) ;1443 end ;1444 end;1445 }1446 if ObtainComment then1447 LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))1448 else1449 DisableCommentPanels;1450 x := '' ;1451 for i := 0 to CurWardComment.Count-1 do1452 x := x + CurWardComment.strings[i]+#13#10 ;1453 i := IndexOfCollSamp(CollSamp);1454 if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do1455 for i := 0 to WardComment.Count-1 do1456 x := x + WardComment.strings[i]+#13#10 ;1457 pnlMessage.TabOrder := cboAvailComp.TabOrder + 1;1458 OrderMessage(x) ;1459 end; { with }1460 StatusText('');1461 Changing := False;1462 end;1463 1464 procedure TfrmODBBank.DisableCommentPanels;1465 begin1466 lblReqComment.Visible := False;1467 end;1468 1469 procedure TfrmODBBank.DisableComponentControls;1470 begin1471 lblModifiers.Enabled := false;1472 cboModifiers.Enabled := false;1473 lblWanted.Enabled := false;1474 calWantTime.Enabled := false;1475 //lblPreparation.Enabled := false;1476 //cboPreparation.Enabled := false;1477 lblSurgery.Enabled := false;1478 cboSurgery.Enabled := false;1479 lblReason.Enabled := false;1480 tReason.Enabled := false;1481 chkConsent.Enabled := false;1482 lblQuantity.Enabled := false;1483 tQuantity.Enabled := false;1484 upQuantity.Enabled := false;1485 cboAvailComp.ItemIndex := -1;1486 tQuantity.Text := '0';1487 end;1488 1489 procedure TfrmODBBank.EnableComponentControls;1490 begin1491 lblModifiers.Enabled := true;1492 cboModifiers.Enabled := true;1493 lblWanted.Enabled := true;1494 calWantTime.Enabled := true;1495 //lblPreparation.Enabled := true;1496 //cboPreparation.Enabled := true;1497 if cboUrgency.Text = 'PRE-OP' then1498 begin1499 lblSurgery.Enabled := true;1500 cboSurgery.Enabled := true;1501 end;1502 lblReason.Enabled := true;1503 tReason.Enabled := true;1504 chkConsent.Enabled := true;1505 lblQuantity.Enabled := true;1506 tQuantity.Enabled := true;1507 upQuantity.Enabled := true;1508 txtDiagComment.Enabled := true;1509 2932 lblDiagComment.Enabled := true; 1510 2933 end; … … 1515 2938 calCollTime.Enabled := false; 1516 2939 cboCollTime.Enabled := false; 1517 cboAvailTest.ItemIndex := -1;1518 2940 lblCollType.Enabled := false; 1519 2941 cboCollType.Enabled := false; 1520 2942 cmdImmedColl.Enabled := false; 2943 cboAvailTest.ItemIndex := -1; 2944 cboAvailTest.InitLongList(''); 1521 2945 end; 1522 2946 1523 2947 procedure TfrmODBBank.EnableDiagTestControls; 1524 2948 begin 1525 calWantTime.Enabled := true;1526 lblWanted.Enabled := true;1527 2949 lblCollTime.Enabled := true; 1528 2950 calCollTime.Enabled := true; … … 1530 2952 lblCollType.Enabled := true; 1531 2953 cboCollType.Enabled := true; 1532 lblUrgency.Enabled := true;1533 cboUrgency.Enabled := true;1534 txtDiagComment.Enabled := true;1535 lblDiagComment.Enabled := true;1536 2954 cmdImmedColl.Enabled := true; 2955 if not(changing) then 2956 if not(uSelUrgency = 'PRE-OP') then 2957 if uSelUrgency = '' then 2958 if lvSelectionList.Items.Count < 1 then 2959 cboUrgency.SelectByID(IntToStr(uDfltUrgency)); 1537 2960 end; 1538 2961 … … 1548 2971 begin 1549 2972 if ALabTest = nil then exit; 2973 if ALabTest.LabSubscript = 'BB' then exit; 1550 2974 calCollTime.Clear; 1551 2975 cboCollTime.Clear; … … 1618 3042 end; 1619 3043 3044 procedure TfrmODBBank.cboAvailCompChange(Sender: TObject); 3045 begin 3046 inherited; 3047 changing := true; 3048 changing := false; 3049 end; 3050 1620 3051 procedure TfrmODBBank.cboAvailCompExit(Sender: TObject); 1621 3052 begin … … 1662 3093 inherited; 1663 3094 case pgeProduct.TabIndex of 1664 TI_ORDER : begin 1665 memMessage.Visible := true; 3095 TI_COMPONENT : begin 1666 3096 memOrder.Visible := true; 1667 3097 cmdAccept.Visible := true; 1668 3098 pnlSelectedTests.Visible := true; 1669 pgeProduct.Height := 281;3099 lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display 1670 3100 end; 1671 3101 TI_INFO : begin 1672 if lvSelectionList.Items.Count > 0 then exit; 1673 LRORDERMODE := TORDER_MODE_INFO; 1674 memMessage.Visible := false; 1675 memOrder.Visible := false; 1676 cmdAccept.Visible := false; 1677 pnlSelectedTests.Visible := false; 1678 pgeProduct.Height := 411; 3102 if lvSelectionList.Items.Count > 0 then 3103 begin 3104 memOrder.Visible := true; 3105 cmdAccept.Visible := true; 3106 pnlSelectedTests.Visible := true; 3107 end 3108 else 3109 begin 3110 memOrder.Visible := false; 3111 cmdAccept.Visible := false; 3112 pnlSelectedTests.Visible := false; 3113 end; 1679 3114 end; 1680 3115 TI_RESULTS : begin 1681 if lvSelectionList.Items.Count > 0 then exit; 1682 memMessage.Visible := false; 1683 memOrder.Visible := false; 1684 cmdAccept.Visible := false; 1685 pnlSelectedTests.Visible := false; 1686 pgeProduct.Height := 411; 3116 if lvSelectionList.Items.Count > 0 then 3117 begin 3118 memOrder.Visible := true; 3119 cmdAccept.Visible := true; 3120 pnlSelectedTests.Visible := true; 3121 end 3122 else 3123 begin 3124 memOrder.Visible := false; 3125 cmdAccept.Visible := false; 3126 pnlSelectedTests.Visible := false; 3127 end; 1687 3128 end; 1688 3129 end; {case} 1689 3130 end; 1690 3131 1691 procedure TfrmODBBank.cboCollTypeChange(Sender: TObject); 1692 begin 1693 if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit; 1694 if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then 1695 begin 1696 InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING); 1697 cboCollType.ItemIndex := -1; 1698 Exit; 1699 end; 1700 SetupCollTimes(cboCollType.ItemID); 1701 end; 1702 1703 procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox); 3132 procedure TfrmODBBank.cboCollTimeChange(Sender: TObject); 1704 3133 var 1705 i: integer; 1706 begin 1707 with AComboBox do 1708 begin 1709 Clear; 1710 for i := 0 to uModifierList.Count - 1 do 1711 Items.Add(uModifierList[i]); 1712 end; 1713 end; 1714 1715 procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox); 1716 var 1717 i: integer; 1718 begin 1719 with AComboBox do 1720 begin 1721 Clear; 1722 for i := 0 to uUrgencyList.Count - 1 do 1723 if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then 1724 Continue 1725 else 1726 Items.Add(uUrgencyList[i]); 1727 end; 1728 end; 1729 1730 procedure TfrmODBBank.btnAddTestsClick(Sender: TObject); 1731 var 1732 aList, aTests, aRaw: TStringList; 1733 ListItem: TListItem; 1734 aStr, aMsg: String; //add independent structures for components, Tests, and associated fields. 1735 aCollType, aModifier, aPreparation, aSurgery, aCollTime, aTestYes, aSpecimen, aCollSave: String; 1736 CurAdd, i, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue: Integer; 1737 x, name, aTypeScreen: String; 1738 begin 1739 if not ValidAdd then Exit; 1740 aList := TStringList.Create; 1741 aTests := TStringList.Create; 1742 aRaw := TStringList.Create; 1743 try 1744 aCollType := ''; 1745 aModifier := ''; 1746 aPreparation := ''; 1747 aSurgery := ''; 1748 aCollTime := ''; 1749 aTestYes := '0'; 1750 aTypeScreen := ''; 1751 uGetTnS := 0; 1752 aSpecimen := ''; 1753 ExtractTypeScreen(aList, uVBECList); 1754 if aList.Count > 0 then aTypeScreen := aList[0]; 1755 aList.Clear; 1756 ExtractSpecimen(aList, uVBECList); 1757 if aList.Count > 0 then aSpecimen := aList[0]; 1758 if LRORDERMODE = TORDER_MODE_DIAG then aTestYes := '1'; 1759 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex]; 1760 //if length(cboPreparation.ItemID) > 0 then aPreparation := cboPreparation.Items[cboPreparation.ItemIndex]; 1761 if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex]; 1762 if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; 1763 if (LRORDERMODE = TORDER_MODE_DIAG) and (length(cboAvailTest.ItemID) > 0) then 1764 begin 1765 uTestSelected := true; 1766 with lvSelectionList do 1767 begin 1768 ListItem := Items.Add; 1769 ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2); 1770 ListItem.SubItems.Add(''); 1771 if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]) 1772 else ListItem.SubItems.Add(''); 1773 ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1)); 1774 if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then 1775 begin 1776 lblTNS.Caption := ''; 1777 lblTNS.Visible := false; 1778 end; 1779 end; 1780 lblCollTime.Enabled := false; 1781 calCollTime.Enabled := false; 1782 cboCollTime.Enabled := false; 1783 lblCollType.Enabled := false; 1784 cboCollType.Enabled := false; 1785 cboAvailTest.ItemIndex := -1; 1786 end; 1787 if (LRORDERMODE = TORDER_MODE_COMP) and (length(cboAvailComp.ItemID) > 0) then 1788 begin 1789 if Length(cboSurgery.ItemID) > 0 then 1790 begin 1791 aList.Clear; 1792 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey 1793 for i := 0 to aList.Count - 1 do 1794 begin 1795 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) 1796 and (StrToInt(piece(aList[i],'^',2)) = cboSurgery.ItemID) then 1797 begin 1798 aMSBOS := StrToInt(piece(aList[i],'^',4)); 1799 if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then 1800 begin 1801 with Application do 1802 begin 1803 NormalizeTopMosts; 1804 aMSBOSContinue := 1805 MessageBox(PChar('The number of units ordered (' + tQuantity.Text + 1806 ') exceeds the maximum number of units (' + IntToStr(aMSBOS) + 1807 ') for the ' + cboSurgery.text + 1808 ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'), 1809 PChar('Maximum Number of Units Exceeded'), 1810 MB_YESNO); 1811 RestoreTopMosts; 1812 end; 1813 if aMSBOSContinue = 7 then 1814 begin 1815 ShowMessage(cboAvailComp.Text + ' has NOT been added to this request.'); 1816 exit; 1817 end; 1818 end; 1819 end; 1820 end; 1821 end; 1822 if SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then //check to see if type and screen is needed 1823 begin 1824 uGetTnS := 1; 1825 for i := 0 to lvSelectionList.Items.Count - 1 do 1826 begin 1827 if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then 1828 begin 1829 uGetTnS := 0; 1830 uDfltUrgency := cboUrgency.ItemID; 1831 lblTNS.Caption := ''; 1832 lblTNS.Visible := false; 1833 break; 1834 end; 1835 end; 1836 end; 1837 aList.Clear; 1838 ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server 1839 for i := 0 to aList.Count - 1 do 1840 begin 1841 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then 1842 begin 1843 aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen; 1844 break; 1845 end; 1846 end; 1847 uComponentSelected := true; 1848 with lvSelectionList do 1849 begin 1850 ListItem := Items.Add; 1851 ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2); 1852 ListItem.SubItems.Add(tQuantity.Text); 1853 if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]) 1854 else ListItem.SubItems.Add(''); 1855 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); 1856 end; 1857 lblWanted.Enabled := false; 1858 calWantTime.Enabled := false; 1859 //lblPreparation.Enabled := false; 1860 //cboPreparation.Enabled := false; 1861 lblSurgery.Enabled := false; 1862 cboSurgery.Enabled := false; 1863 lblReason.Enabled := false; 1864 tReason.Enabled := false; 1865 chkConsent.Enabled := false; 1866 cboAvailComp.ItemIndex := -1; 1867 end; 1868 if Sender <> Self then 1869 Responses.Clear; // Sender=Self when called from SELF 1870 CurAdd := 1; 1871 aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen; //aSpecimen has 2 pieces 1872 uSelectedItems.Add(aStr); 1873 for i := 0 to uSelectedItems.Count - 1 do 1874 begin 1875 name := lvSelectionList.Items[i].Caption; 1876 x := uSelectedItems[i]; 1877 if piece(x,'^',1) = '1' then //Diagnostic Test related fields 1878 begin 1879 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name); 1880 end 1881 else 1882 begin 1883 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name); 1884 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3)); 1885 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier); 1886 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5)); 1887 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 1888 end; 1889 Inc(CurAdd); 1890 aList.Clear; 1891 TestAdded := 0; 1892 getTest := 0; 1893 ExtractTests(aList, uVBECList); //Get Results associated with ordered components 1894 for j := 0 to aList.Count - 1 do 1895 begin 1896 if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then 1897 begin 1898 if uTestsForResults.Count < 1 then getTest := 1; 1899 for k := 0 to uTestsForResults.Count - 1 do 1900 begin 1901 if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then 1902 begin 1903 getTest := 0; 1904 break; 1905 end 1906 else getTest := 1; 1907 end; 1908 if getTest = 1 then 1909 begin 1910 uTestsForResults.Add(piece(aList[j],'^',3)); 1911 TestAdded := 1; 1912 end; 1913 end; 1914 end; 1915 if TestAdded = 1 then 1916 begin 1917 edtResults.Clear; 1918 aTests.Clear; 1919 GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults); 1920 QuickCopy(ATests,edtResults); 1921 if edtResults.Lines.Count > 0 then TabResults.ImageIndex := 1; 1922 uRaw.Clear; 1923 GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults); 1924 end; 1925 end; 1926 if LRORDERMODE = TORDER_MODE_DIAG then 1927 begin 1928 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 1929 with cboCollType do if Length(ItemID) > 0 then 1930 begin 1931 Responses.Update('COLLECT', 1, ItemID, ItemID) ; 1932 FLastCollType := ItemID; 1933 end; 1934 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 1935 if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text); 1936 if cboCollType.ItemID = 'LC' then 1937 begin 1938 with cboCollTime do 1939 if Length(ItemID) > 0 then 1940 begin 1941 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999)); 1942 FLastLabCollTime := ItemID + U + Text; 1943 end 1944 else if Length(Text) > 0 then 1945 begin 1946 Responses.Update('START', 1, ValidCollTime(Text), Text) ; 1947 FLastLabCollTime := ValidCollTime(Text); 1948 end; 1949 end 1950 else 1951 begin 1952 with calCollTime do 1953 if FMDateTime > 0 then 1954 begin 1955 Responses.Update('START', 1, ValidCollTime(Text), Text); 1956 FLastColltime := ValidCollTime(Text); 1957 end 1958 else 1959 begin 1960 Responses.Update('START', 1, '', '') ; 1961 FLastCollTime := ''; 1962 end; 1963 end; 1964 end; 1965 if LRORDERMODE = TORDER_MODE_COMP then 1966 begin 1967 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 1968 if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text); 1969 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 1970 //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text); 1971 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 1972 if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text); 1973 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes'); 1974 end; 1975 memOrder.Text := Responses.OrderText; 1976 CurAdd := 1; 1977 if uRaw.Count > 0 then 1978 for j := 0 to uRaw.Count - 1 do 3134 CollType: string; 3135 const 3136 TX_BAD_TIME = ' is not a routine lab collection time.' ; 3137 TX_BAD_TIME_CAP = 'Invalid Time'; 3138 begin 3139 CollType := 'LC'; 3140 with cboCollTime do 3141 begin 3142 if ItemID = 'LO' then 1979 3143 begin 1980 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));1981 Inc(CurAdd);3144 ItemIndex := -1; 3145 Text := GetFutureLabTime(FMToday); 1982 3146 end; 1983 tQuantity.Text := '0'; 1984 ALabTest := nil; 1985 finally 1986 aList.Free; 1987 aTests.Free; 1988 aRaw.Free; 1989 end; 1990 aMsg := ''; 1991 if UgetTnS = 1 then 1992 begin 1993 lblTNS.Caption := 'TYPE + SCREEN must be added to order'; 1994 lblTNS.Visible := true; 1995 cboAvailTest.SelectByID(aTypeScreen); 1996 cboAvailTestSelect(self); 1997 end; 1998 {if getTnS = 1 then 1999 begin 2000 for i := 1 to cboAvailTest.Items.Count - 1 do 2001 begin 2002 if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then 2003 begin 2004 if piece(aSpecimen,'^',1) = '1' then 2005 begin 2006 cboCollTime.Text := calWantTime.Text; 2007 aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID; 2008 cboCollTime.Text := ''; 2009 cboCollType.Text := ''; 2010 uSpecimen := 1; 2011 end; 2012 cboModifiers.Text := ''; 2013 cboAvailTest.SelectByID(aTypeScreen); 2014 cboAvailTestSelect(Self); 2015 btnAddTestsClick(Self); 2016 uSpecimen := 0; 2017 cboCollTime.Text := piece(aCollSave,'^',1); 2018 cboCollType.Text := piece(aCollSave,'^',3); 2019 aCollSave := ''; 2020 break; 2021 end; 2022 end; 2023 aMsg := 'An order for Type and Screen has been added to this request' + '.'; 2024 end; 2025 if (getTns = 1) then 2026 begin 2027 if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf; 2028 ShowMessage(aMsg); 2029 end;} 2030 cboModifiers.Text := ''; 2031 edtResults.Height := 247; 2032 edtInfo.Height := 247; 2033 end; 2034 2035 procedure TfrmODBBank.FormDestroy(Sender: TObject); 2036 begin 2037 inherited; 2038 uSelectedItems.Free; 2039 uVBECList.Free; 2040 uTestsForResults.Free; 2041 uUrgencyList.Free; 2042 uModifierList.Free; 2043 uRaw.Free; 2044 end; 2045 2046 procedure TfrmODBBank.btnRemoveClick(Sender: TObject); 2047 var 2048 i,j,curAdd: integer; 2049 x, name, aModifier, aTypeScreen: string; 2050 aList: TStringList; 2051 begin 2052 inherited; 2053 aList := TStringList.Create; 2054 curAdd := 1; 2055 aModifier := ''; 2056 aTypeScreen := ''; 2057 ExtractTypeScreen(aList, uVBECList); 2058 if aList.Count > 0 then aTypeScreen := aList[0]; 2059 aList.Clear; 2060 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex]; 2061 with lvSelectionList do 2062 begin 2063 for i := lvSelectionList.Items.Count - 1 downto 0 do 2064 begin 2065 if lvSelectionList.Items[i].Selected = true then 2066 for j := uSelectedItems.Count - 1 downto 0 do 2067 if lvSelectionList.Items[i].SubItems[2] = piece(uSelectedItems[j],'^',2) then 2068 begin 2069 if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then 2070 begin 2071 uGetTnS := 1; 2072 lblTNS.Caption := 'TYPE+SCREEN must be added to order'; 2073 lblTNS.Visible := true; 2074 end; 2075 uSelectedItems.Delete(j); 2076 lvSelectionList.Items[i].Delete; 2077 break; 2078 end; 2079 end; 2080 end; 2081 Responses.Clear; 2082 for i := 0 to uSelectedItems.Count - 1 do 2083 begin 2084 name := lvSelectionList.Items[i].Caption; 2085 x := uSelectedItems[i]; 2086 if piece(x,'^',1) = '1' then //Diagnostic Test related fields 2087 begin 2088 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name); 2089 end 2090 else 2091 begin 2092 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name); 2093 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3)); 2094 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier); 2095 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5)); 2096 end; 2097 Inc(CurAdd); 2098 end; 2099 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 2100 if cboCollType.ItemID = 'LC' then 3147 end; 3148 cboCollType.SelectByID(CollType); 3149 if uSelectedItems.Count > 0 then 2101 3150 begin 2102 3151 with cboCollTime do … … 2111 3160 FLastLabCollTime := ValidCollTime(Text); 2112 3161 end; 3162 end; 3163 end; 3164 3165 procedure TfrmODBBank.cboCollTypeChange(Sender: TObject); 3166 begin 3167 if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit; 3168 if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then 3169 begin 3170 InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING); 3171 cboCollType.ItemIndex := -1; 3172 Exit; 3173 end; 3174 if cboCollType.ItemID = 'I' then 3175 begin 3176 cboCollTime.ItemIndex := -1; 3177 cboCollTime.Text := 'NOW'; 3178 calCollTime.Text := 'NOW'; 3179 end; 3180 SetupCollTimes(cboCollType.ItemID); 3181 if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID); 3182 FLastCollType := cboCollType.ItemID; 3183 calCollTimeChange(self); 3184 end; 3185 3186 procedure TfrmODBBank.cboModifiersChange(Sender: TObject); 3187 var 3188 i: integer; 3189 ListItem: TListItem; 3190 x,q,m: string; 3191 begin 3192 inherited; 3193 if changing = true then Exit; 3194 if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then 3195 begin 3196 for i := 0 to lvSelectionList.Items.Count - 1 do 3197 begin 3198 x := uSelectedItems[i]; 3199 m := piece(x,'^',4); 3200 q := piece(x,'^',3); 3201 if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then 3202 begin 3203 ListItem := lvSelectionList.Items[i]; 3204 ListItem.SubItems.Clear; 3205 ListItem.SubItems.Add(q); 3206 if length(cboModifiers.ItemID) > 0 then 3207 begin 3208 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); 3209 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); 3210 end 3211 else 3212 begin 3213 ListItem.SubItems.Add(''); 3214 ListItem.SubItems.Add(''); 3215 end; 3216 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); 3217 Responses.Update('MODIFIER', (i+1), cboModifiers.Text, cboModifiers.Text); 3218 Break; 3219 end; 3220 end; 3221 end; 3222 if Length(cboModifiers.Text) > 0 then 3223 begin 3224 memOrder.Text := Responses.OrderText; 3225 end; 3226 end; 3227 3228 procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox); 3229 var 3230 i: integer; 3231 begin 3232 with AComboBox do 3233 begin 3234 Clear; 3235 for i := 0 to uModifierList.Count - 1 do 3236 Items.Add(uModifierList[i]); 3237 end; 3238 end; 3239 3240 procedure TfrmODBBank.LoadReasons(AComboBox:TORComboBox); 3241 var 3242 i: integer; 3243 begin 3244 with AComboBox do 3245 begin 3246 Clear; 3247 for i := 0 to uReasonsList.Count - 1 do 3248 Items.Add(uReasonsList[i]); 3249 end; 3250 end; 3251 3252 procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox); 3253 var 3254 i: integer; 3255 begin 3256 with AComboBox do 3257 begin 3258 Clear; 3259 for i := 0 to uUrgencyList.Count - 1 do 3260 if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then 3261 Continue 3262 else 3263 Items.Add(uUrgencyList[i]); 3264 end; 3265 end; 3266 3267 procedure TfrmODBBank.lvSelectionListClick(Sender: TObject); 3268 var 3269 ListItem: TListItem; 3270 x,y: string; 3271 i,j: integer; 3272 begin 3273 inherited; 3274 if lvSelectionList.Selected = nil then Exit; 3275 ListItem := lvSelectionList.Selected; 3276 changing := true; 3277 tQuantity.Text := ''; 3278 cboModifiers.ItemIndex := -1; 3279 i := lvSelectionList.ItemIndex; 3280 j := 0; 3281 if cboCollType.ItemID = 'LC' then 3282 begin 3283 if FLastLabCollTime <> '' then 3284 cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1)); 2113 3285 end 2114 3286 else 2115 3287 begin 2116 with calCollTime do 2117 if FMDateTime > 0 then 3288 if FLastCollTime = 'TODAY' then 3289 calCollTime.Text := FLastCollTime 3290 else if FLastCollTime = 'NOW' then 3291 calCollTime.Text := FLastCollTime 3292 else if FLastCollTime <> '' then 3293 calCollTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',StrToFMDateTime(FLastCollTime)); 3294 end; 3295 if FLastCollType <> '' then 3296 cboCollType.SelectByID(FLastCollType); 3297 if uSelectedItems.Count > 0 then 3298 begin 3299 x := uSelectedItems[i]; 3300 ALabTest := TLabTest.Create(piece(uSelectedItems[i],'^',2), Responses); 3301 if not(piece(x,'^',2) = '') then j := StrToInt(piece(x,'^',2)); 3302 if not(piece(x,'^',1) = '1') and (j > 0) then //Components 3303 begin 3304 DisableDiagTestControls; 3305 EnableComponentControls; 3306 y := ListItem.SubItems[2]; 3307 changing := true; 3308 cboModifiers.Text := ''; 3309 cboAvailComp.SelectByIEN(j); 3310 tQuantity.Text := ListItem.SubItems[0]; 3311 changing := false; 3312 if y <> '' then cboModifiers.ItemIndex := StrToInt(y); 3313 end 3314 else //Diagnostic Tests 3315 begin 3316 DisableComponentControls; 3317 EnableDiagTestControls; 3318 cboAvailTest.SelectByIEN(j); 3319 end; 3320 end; 3321 changing := false; 3322 end; 3323 3324 procedure TfrmODBBank.memDiagCommentChange(Sender: TObject); 3325 begin 3326 inherited; 3327 if (length(memDiagComment.Text) > 250) then 3328 begin 3329 ShowMsg('COMMENT cannot be longer than 250 characters'); 3330 memDiagComment.Text := Copy(memDiagComment.Text,0,250); 3331 Exit; 3332 end; 3333 if lvSelectionList.Items.Count < 1 then Exit; 3334 3335 if uSelectedItems = nil then Exit; 3336 3337 if uSelectedItems.Count > 0 then 3338 Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); 3339 memOrder.Text := Responses.OrderText; 3340 end; 3341 3342 procedure TfrmODBBank.FormDestroy(Sender: TObject); 3343 begin 3344 inherited; 3345 uSelectedItems.Free; 3346 uVBECList.Free; 3347 uTestsForResults.Free; 3348 uUrgencyList.Free; 3349 uTNSOrders.Free; 3350 uModifierList.Free; 3351 uReasonsList.Free; 3352 uRaw.Free; 3353 end; 3354 3355 procedure TfrmODBBank.btnRemoveClick(Sender: TObject); 3356 var 3357 i,j,curAdd: integer; 3358 x, aName, aModifier, aReason, aTypeScreen: string; 3359 aList: TStringList; 3360 aSel, aSelTst : boolean; 3361 begin 3362 inherited; 3363 aList := TStringList.Create; 3364 try 3365 curAdd := 1; 3366 aModifier := ''; 3367 aReason := ''; 3368 aTypeScreen := ''; 3369 aSel := false; 3370 aSelTst := false; 3371 ExtractTypeScreen(aList, uVBECList); 3372 if aList.Count > 0 then aTypeScreen := aList[0]; 3373 aList.Clear; 3374 if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex]; 3375 if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex]; 3376 if lvSelectionList.Items.Count < 1 then 3377 begin 3378 ShowMsg('There is nothing in the list to remove.'); 3379 exit; 3380 end; 3381 cboAvailComp.ItemIndex := -1; 3382 tQuantity.Text := ''; 3383 cboAvailTest.ItemIndex := -1; 3384 uGetTnS := 0; 3385 lblTNS.Caption := ''; 3386 lblTNS.Visible := false; 3387 memMessage.Text := ''; 3388 pnlMessage.Visible := false; 3389 pnlDiagnosticTests.Caption := 'Diagnostic Tests'; 3390 with lvSelectionList do 3391 begin 3392 for i := lvSelectionList.Items.Count - 1 downto 0 do 2118 3393 begin 2119 Responses.Update('START', 1, ValidCollTime(Text), Text); 2120 FLastColltime := ValidCollTime(Text); 3394 if lvSelectionList.Items[i].Selected = true then 3395 begin 3396 aSel := true; 3397 for j := uSelectedItems.Count - 1 downto 0 do 3398 if lvSelectionList.Items[i].SubItems[3] = piece(uSelectedItems[j],'^',2) then 3399 begin 3400 {if (uGetTnS = 1) and (lvSelectionList.Items[i].SubItems[3] = aTypeScreen) then 3401 begin 3402 uGetTnS := 1; 3403 lblTNS.Caption := 'TYPE+SCREEN must be added to order'; 3404 lblTNS.Visible := true; 3405 memMessage.Text := 'TYPE + SCREEN must be added to order'; 3406 //memMessage.Visible := true; 3407 pnlMessage.Visible := true; 3408 pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; 3409 end; } 3410 uSelectedItems.Delete(j); 3411 lvSelectionList.Items[i].Delete; 3412 break; 3413 end; 3414 end; 3415 end; 3416 end; 3417 for i := uSelectedItems.Count - 1 downto 0 do 3418 begin 3419 if (not(piece(uSelectedItems[i],'^',1) = '1')) and (uTNSOrders.Count < 1) then // and (SpecimenNeeded(aList, uVBECList, StrToInt(piece(uSelectedItems[i],'^',9)))) then 3420 begin 3421 uGetTnS := 1; 3422 lblTNS.Caption := 'TYPE+SCREEN must be added to order'; 3423 lblTNS.Visible := true; 3424 memMessage.Text := 'TYPE + SCREEN must be added to order'; 3425 //memMessage.Visible := true; 3426 pnlMessage.Visible := true; 3427 pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; 3428 break; 3429 end; 3430 end; 3431 3432 if (aSel = false) and (lvSelectionList.Items.Count > 0) then 3433 begin 3434 ShowMsg('Please select an item from the list to be removed.'); 3435 exit; 3436 end; 3437 Responses.Clear; 3438 if lvSelectionList.Items.Count < 1 then 3439 begin 3440 cboReasons.ItemIndex := -1; 3441 memDiagComment.Text := ''; 3442 cboSurgery.ItemIndex := -1; 3443 cboUrgency.ItemIndex := -1; 3444 cboCollType.ItemIndex := -1; 3445 cboCollTime.ItemIndex := -1; 3446 cboQuick.ItemIndex := -1; 3447 calCollTime.Text := ''; 3448 end; 3449 for i := 0 to uSelectedItems.Count - 1 do 3450 begin 3451 aName := lvSelectionList.Items[i].Caption; 3452 x := uSelectedItems[i]; 3453 if piece(x,'^',1) = '1' then //Diagnostic Test related fields 3454 begin 3455 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 3456 aSelTst := true; 2121 3457 end 2122 3458 else 2123 3459 begin 2124 Responses.Update('START', 1, '', '') ; 2125 FLastCollTime := ''; 3460 if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 3461 if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3)); 3462 if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier); 3463 if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5)); 3464 cboModifiers.ItemIndex := -1; 3465 cboAvailComp.ItemIndex := -1; 3466 tQuantity.Text := ''; 2126 3467 end; 2127 end;2128 with cboCollType do if Length(ItemID) > 0 then2129 begin2130 Responses.Update('COLLECT', 1, ItemID, ItemID) ;2131 FLastCollType := ItemID;2132 end;2133 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);2134 if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);2135 //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);2136 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);2137 if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);2138 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');2139 memOrder.Text := Responses.OrderText;2140 CurAdd := 1;2141 if uRaw.Count > 0 then2142 for j := 0 to uRaw.Count - 1 do2143 begin2144 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));2145 3468 Inc(CurAdd); 2146 3469 end; 2147 if uSelectedItems.Count < 1 then 2148 begin 2149 uGetTnS := 0; 2150 lblTNS.Caption := ''; 2151 lblTNS.Visible := false; 2152 end; 2153 aList.Free; 3470 if aSelTst = false then 3471 begin 3472 cboCollType.ItemIndex := -1; 3473 cboCollTime.ItemIndex := -1; 3474 calCollTime.Text := ''; 3475 end; 3476 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 3477 if cboCollType.ItemID = 'LC' then 3478 begin 3479 with cboCollTime do 3480 if Length(ItemID) > 0 then 3481 begin 3482 Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999)); 3483 FLastLabCollTime := ItemID + U + Text; 3484 end 3485 else if Length(Text) > 0 then 3486 begin 3487 Responses.Update('START', 1, ValidCollTime(Text), Text) ; 3488 FLastLabCollTime := ValidCollTime(Text); 3489 end; 3490 end 3491 else 3492 begin 3493 with calCollTime do 3494 if FMDateTime > 0 then 3495 begin 3496 Responses.Update('START', 1, ValidCollTime(Text), Text); 3497 FLastColltime := ValidCollTime(Text); 3498 end 3499 else 3500 begin 3501 Responses.Update('START', 1, '', '') ; 3502 FLastCollTime := ''; 3503 end; 3504 end; 3505 with cboCollType do if Length(ItemID) > 0 then 3506 begin 3507 Responses.Update('COLLECT', 1, ItemID, ItemID) ; 3508 FLastCollType := ItemID; 3509 end; 3510 if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 3511 if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); 3512 if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 3513 if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text); 3514 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes'); 3515 memOrder.Text := Responses.OrderText; 3516 CurAdd := 1; 3517 if uRaw.Count > 0 then 3518 for j := 0 to uRaw.Count - 1 do 3519 begin 3520 if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1)); 3521 Inc(CurAdd); 3522 end; 3523 if uSelectedItems.Count < 1 then 3524 begin 3525 uGetTnS := 0; 3526 lblTNS.Caption := ''; 3527 lblTNS.Visible := false; 3528 memMessage.Text := ''; 3529 pnlMessage.Visible := false; 3530 GroupBox1.Visible := true; 3531 pnlDiagnosticTests.Caption := 'Diagnostic Tests'; 3532 end; 3533 finally 3534 aList.Free; 3535 end; 3536 end; 3537 3538 procedure TfrmODBBank.btnUpdateCommentsClick(Sender: TObject); 3539 begin 3540 inherited; 3541 pnlComments.Visible := false; 3542 pnlComments.SendToBack; 3543 Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); 3544 memOrder.Text := Responses.OrderText; 3545 end; 3546 3547 procedure TfrmODBBank.btnCancelCommentClick(Sender: TObject); 3548 begin 3549 inherited; 3550 pnlComments.Visible := false; 3551 pnlComments.SendToBack; 2154 3552 end; 2155 3553 … … 2157 3555 begin 2158 3556 inherited; 3557 if lvSelectionList.Items.Count < 1 then 3558 begin 3559 ShowMsg('There is nothing in the list to remove.'); 3560 exit; 3561 end; 2159 3562 lvSelectionList.Clear; 2160 3563 uSelectedItems.Clear; … … 2164 3567 lblTNS.Caption := ''; 2165 3568 lblTNS.Visible := false; 3569 memMessage.Text := ''; 3570 pnlMessage.Visible := false; 2166 3571 InitDialog; 3572 cboModifiers.ItemIndex := -1; 3573 cboAvailTest.ItemIndex := -1; 3574 cboAvailComp.ItemIndex := -1; 3575 cboSurgery.ItemIndex := -1; 3576 cboUrgency.ItemIndex := -1; 3577 cboReasons.ItemIndex := -1; 3578 cboCollType.ItemIndex := -1; 3579 cboCollTime.ItemIndex := -1; 3580 cboQuick.ItemIndex := -1; 3581 calWantTime.Text := ''; 3582 memDiagComment.Text := ''; 3583 GroupBox1.Visible := true; 3584 tQuantity.Text := ''; 3585 FLastCollType := ''; 3586 FLastCollTime := ''; 3587 FLastLabCollTime := ''; 3588 txtImmedColl.Text := ''; 2167 3589 end; 2168 3590 … … 2175 3597 Txt2 = #13+#13+'An order for TYPE and SCREEN must be created with this order set.'; 2176 3598 begin 3599 if not ValidAdd then Exit; 2177 3600 if uGetTnS = 1 then 2178 3601 begin … … 2191 3614 end; 2192 3615 if Comp = true then 2193 ShowMessage('The nursing blood administration order must be entered separately' + '.'); 3616 begin 3617 if NursAdminSuppress = true then 3618 ShowMsg('The nursing blood administration order must be entered separately' + '.'); 3619 end; 2194 3620 inherited; 2195 3621 end; … … 2199 3625 inherited; 2200 3626 if uSelectedItems.Count > 0 then 2201 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 3627 begin 3628 with calWantTime do if not Changing then 3629 begin 3630 if FMDateTime = 0 then 3631 begin 3632 ShowMsg('Invalid Date/Time entered'); 3633 Changing := true; 3634 calWantTime.Text := ''; 3635 Changing := false; 3636 Exit; 3637 end 3638 else 3639 begin 3640 // date/time was entered 3641 if (UpperCase(Text) <> 'NOW') and not(Trunc(FMNow) = Trunc(FMDateTime)) and (FMDateTime < FMNow) then 3642 begin 3643 ShowMsg('Date/Time Wanted must be a future Date/Time'); 3644 Changing := true; 3645 calWantTime.Text := ''; 3646 Changing := false; 3647 Exit; 3648 end; 3649 end; 3650 end; 3651 if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); 3652 memOrder.Text := Responses.OrderText; 3653 end; 2202 3654 end; 2203 3655 … … 2207 3659 if uSelectedItems.Count > 0 then 2208 3660 begin 2209 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes') 2210 else Responses.Update('YN',1,'0','No');3661 if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes'); 3662 memOrder.Text := Responses.OrderText; 2211 3663 end; 2212 3664 end; … … 2218 3670 begin 2219 3671 Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); 3672 uSelUrgency := cboUrgency.Text; 2220 3673 if cboUrgency.Text = 'PRE-OP' then 2221 3674 begin 2222 3675 lblSurgery.Enabled := true; 2223 3676 cboSurgery.Enabled := true; 3677 lblSurgery.Caption := 'Surgery*'; 2224 3678 end 2225 3679 else … … 2227 3681 lblSurgery.Enabled := false; 2228 3682 cboSurgery.Enabled := false; 2229 cboSurgery.Text := '';2230 if uSelectedItems.Count > 0 then2231 3683 lblSurgery.Caption := 'Surgery'; 3684 cboSurgery.ItemIndex := -1; 3685 Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 2232 3686 end; 2233 end; 2234 end; 2235 2236 procedure TfrmODBBank.txtDiagCommentChange(Sender: TObject); 3687 end 3688 else 3689 cboUrgency.SelectByID(IntToStr(uDfltUrgency)); 3690 memOrder.Text := Responses.OrderText; 3691 end; 3692 3693 procedure TfrmODBBank.cboUrgencyExit(Sender: TObject); 2237 3694 begin 2238 3695 inherited; 2239 if uSelectedItems.Count > 0 then 2240 Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text); 2241 end; 2242 2243 procedure TfrmODBBank.cboPreparationChange(Sender: TObject); 3696 if Length(cboUrgency.Text) < 1 then 3697 cboUrgency.SelectByID(IntToStr(uDfltUrgency)); 3698 end; 3699 3700 procedure TfrmODBBank.cboSurgeryChange(Sender: TObject); 3701 var 3702 aList: TStringList; 3703 i,j,aMSBOS,aMSBOSContinue: integer; 3704 x: string; 3705 handled: boolean; 2244 3706 begin 2245 3707 inherited; 2246 Exit; // disable Preparation, since it is no longer needed by VBECS 2247 if uSelectedItems.Count > 0 then 2248 if Length(cboPreparation.Text) > 0 then 2249 Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text); 2250 end; 2251 2252 procedure TfrmODBBank.cboSurgeryChange(Sender: TObject); 3708 aList := TStringList.Create; 3709 handled := false; 3710 try 3711 if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then 3712 begin 3713 aList.Clear; 3714 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey 3715 for i := 0 to aList.Count - 1 do 3716 begin 3717 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) 3718 and (piece(aList[i],'^',3) = cboSurgery.Text) then 3719 begin 3720 aMSBOS := StrToInt(piece(aList[i],'^',4)); 3721 if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then 3722 begin 3723 with Application do 3724 begin 3725 NormalizeTopMosts; 3726 aMSBOSContinue := 3727 MessageBox(PChar('The number of unit Quantity selected (' + tQuantity.Text + 3728 ') for ' + aLabTest.TestName + ' exceeds the maximum number of units (' 3729 + IntToStr(aMSBOS) + 3730 ') for the ' + cboSurgery.text + 3731 ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + tQuantity.Text + ' units?'), 3732 PChar('Maximum Number of Units Exceeded'), 3733 MB_YESNO); 3734 RestoreTopMosts; 3735 end; 3736 if aMSBOSContinue = 7 then 3737 begin 3738 ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text); 3739 tQuantity.Text := '0'; 3740 tQuantity.SelLength := 2; 3741 tQuantity.SelectAll; 3742 break; 3743 end; 3744 end; 3745 handled := true; 3746 break; 3747 end; 3748 end; 3749 end; 3750 if (handled = false) and (Length(cboSurgery.ItemID) > 0) and (uSelectedItems.Count > 0) then 3751 begin 3752 aList.Clear; 3753 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey 3754 for j := 0 to uSelectedItems.Count - 1 do 3755 begin 3756 ALabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses); 3757 for i := 0 to aList.Count - 1 do 3758 begin 3759 if (piece(uSelectedItems[j],'^',1) = '0') 3760 and (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) 3761 and (piece(aList[i],'^',3) = cboSurgery.Text) then 3762 begin 3763 aMSBOS := StrToInt(piece(aList[i],'^',4)); 3764 if (aMSBOS > 0) and (length(piece(uSelectedItems[j],'^',3)) > 0) and (StrToInt(piece(uSelectedItems[j],'^',3)) > aMSBOS) then 3765 begin 3766 with Application do 3767 begin 3768 NormalizeTopMosts; 3769 aMSBOSContinue := 3770 MessageBox(PChar('The number of unit Quantity selected (' + piece(uSelectedItems[j],'^',3) + 3771 ') for ' + lvSelectionList.Items[j].Caption + ' exceeds the maximum number of units (' 3772 + IntToStr(aMSBOS) + 3773 ') for the ' + cboSurgery.text + 3774 ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + piece(uSelectedItems[j],'^',3) + ' units?'), 3775 PChar('Maximum Number of Units Exceeded'), 3776 MB_YESNO); 3777 RestoreTopMosts; 3778 end; 3779 if aMSBOSContinue = 7 then 3780 begin 3781 ShowMsg('Please enter a new quantity for ' + lvSelectionList.Items[j].Caption); 3782 tQuantity.Text := '0'; 3783 tQuantity.SelLength := 2; 3784 tQuantity.SelectAll; 3785 x := uSelectedItems[j]; 3786 SetPiece(x,U,3,''); 3787 uSelectedItems[j] := x; 3788 lvSelectionList.Items[j].SubItems[0] := ''; 3789 RePaint; 3790 break; 3791 end; 3792 end; 3793 break; 3794 end; 3795 end; 3796 end; 3797 end; 3798 if uSelectedItems.Count > 0 then 3799 if Length(cboSurgery.Text) > 0 then 3800 Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 3801 uSelSurgery := 0; 3802 if Length(cboSurgery.Text) > 0 then 3803 begin 3804 if length(cboSurgery.ItemID) > 0 then uSelSurgery := cboSurgery.ItemID; 3805 cboReasons.Text := cboSurgery.Text; 3806 Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text); 3807 end; 3808 memOrder.Text := Responses.OrderText; 3809 finally 3810 aList.Free; 3811 end; 3812 end; 3813 3814 procedure TfrmODBBank.cboSurgeryClick(Sender: TObject); 2253 3815 begin 2254 3816 inherited; 2255 if uSelectedItems.Count > 0 then 2256 if Length(cboSurgery.Text) > 0 then 2257 Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); 2258 end; 2259 2260 procedure TfrmODBBank.tReasonChange(Sender: TObject); 3817 if Length(cboSurgery.Text) > 0 then uSelSurgery := cboSurgery.ItemID; 3818 end; 3819 3820 procedure TfrmODBBank.tQuantityChange(Sender: TObject); 3821 var 3822 aList: TStringList; 3823 i,aMSBOS,aMSBOSContinue: integer; 3824 ListItem: TListItem; 3825 x,m: string; 2261 3826 begin 2262 3827 inherited; 2263 if uSelectedItems.Count > 0 then 2264 if Length(tReason.Text) > 0 then 2265 Responses.Update('REASON',1,tReason.Text,tReason.Text); 3828 if changing = true then Exit; 3829 aList := TStringList.Create; 3830 if Length(tQuantity.Text) > 0 then 3831 begin 3832 if Length(tQuantity.Text) > 2 then 3833 begin 3834 ShowMsg('Invalid entry. Please select a numeric value <100'); 3835 tQuantity.Text := ''; 3836 Exit; 3837 end; 3838 if StrToInt(tQuantity.Text) > 100 then 3839 begin 3840 ShowMsg('Quantity too high. Please select a value <100'); 3841 tQuantity.Text := Copy(tQuantity.Text,0,1); 3842 Exit; 3843 end; 3844 end; 3845 try 3846 if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then 3847 begin 3848 aList.Clear; 3849 ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgery 3850 for i := 0 to aList.Count - 1 do 3851 begin 3852 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) 3853 and (piece(aList[i],'^',3) = cboSurgery.Text) then 3854 begin 3855 aMSBOS := StrToInt(piece(aList[i],'^',4)); 3856 if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then 3857 begin 3858 with Application do 3859 begin 3860 NormalizeTopMosts; 3861 aMSBOSContinue := 3862 MessageBox(PChar('The number of units ordered (' + tQuantity.Text + 3863 ') for ' + aLabTest.TestName + ' exceeds the maximum number of units (' 3864 + IntToStr(aMSBOS) + 3865 ') for the ' + cboSurgery.text + 3866 ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'), 3867 PChar('Maximum Number of Units Exceeded'), 3868 MB_YESNO); 3869 RestoreTopMosts; 3870 end; 3871 if aMSBOSContinue = 7 then 3872 begin 3873 ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text); 3874 tQuantity.Text := '0'; 3875 tQuantity.SelLength := 2; 3876 tQuantity.SelectAll; 3877 break; 3878 end; 3879 end; 3880 break; 3881 end; 3882 end; 3883 end; 3884 if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then 3885 for i := 0 to lvSelectionList.Items.Count - 1 do 3886 begin 3887 if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then 3888 begin 3889 x := uSelectedItems[i]; 3890 m := piece(x,'^',4); 3891 ListItem := lvSelectionList.Items[i]; 3892 ListItem.SubItems.Clear; 3893 ListItem.SubItems.Add(tQuantity.Text); 3894 SetPiece(x,U,3,tQuantity.Text); 3895 Responses.Update('QTY', (i+1), tQuantity.Text, tQuantity.Text); 3896 uSelectedItems[i] := x; 3897 if length(cboModifiers.ItemID) > 0 then 3898 begin 3899 ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); 3900 ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); 3901 end 3902 else 3903 begin 3904 ListItem.SubItems.Add(''); 3905 ListItem.SubItems.Add(''); 3906 end; 3907 3908 ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); 3909 Break; 3910 end; 3911 end; 3912 if Length(tQuantity.Text) > 0 then 3913 begin 3914 memOrder.Text := Responses.OrderText; 3915 end; 3916 finally 3917 aList.Free; 3918 end; 3919 end; 3920 3921 procedure TfrmODBBank.tQuantityClick(Sender: TObject); 3922 begin 3923 inherited; 3924 tQuantity.SelLength := 2; 3925 tQuantity.SelectAll; 3926 end; 3927 3928 procedure TfrmODBBank.tQuantityEnter(Sender: TObject); 3929 begin 3930 inherited; 3931 tQuantity.SelLength := 2; 3932 tQuantity.SelectAll; 2266 3933 end; 2267 3934 … … 2299 3966 end; 2300 3967 end; 3968 memOrder.Text := Responses.OrderText; 2301 3969 end; 2302 3970 end; -
cprs/trunk/CPRS-Chart/Orders/fODBase.dfm
r456 r829 9 9 VertScrollBar.Range = 225 10 10 VertScrollBar.Visible = True 11 AutoScroll = False12 11 BorderIcons = [biSystemMenu] 13 12 Caption = '' 14 13 FormStyle = fsStayOnTop 15 KeyPreview = True16 14 OnClose = FormClose 17 15 OnCloseQuery = FormCloseQuery 18 16 OnCreate = FormCreate 19 17 OnKeyPress = FormKeyPress 18 ExplicitWidth = 528 19 ExplicitHeight = 275 20 20 PixelsPerInch = 96 21 21 TextHeight = 13 22 object memOrder: TCaptionMemo 22 object memOrder: TCaptionMemo [0] 23 23 Left = 6 24 24 Top = 194 … … 34 34 Caption = 'Order' 35 35 end 36 object cmdAccept: TButton 36 object cmdAccept: TButton [1] 37 37 Left = 442 38 38 Top = 194 … … 43 43 OnClick = cmdAcceptClick 44 44 end 45 object cmdQuit: TButton 45 object cmdQuit: TButton [2] 46 46 Left = 442 47 47 Top = 221 … … 53 53 OnClick = cmdQuitClick 54 54 end 55 object pnlMessage: TPanel 55 object pnlMessage: TPanel [3] 56 56 Left = 24 57 57 Top = 176 … … 92 92 end 93 93 end 94 inherited amgrMain: TVA508AccessibilityManager 95 Data = ( 96 ( 97 'Component = memOrder' 98 'Status = stsDefault') 99 ( 100 'Component = cmdAccept' 101 'Status = stsDefault') 102 ( 103 'Component = cmdQuit' 104 'Status = stsDefault') 105 ( 106 'Component = pnlMessage' 107 'Status = stsDefault') 108 ( 109 'Component = memMessage' 110 'Status = stsDefault') 111 ( 112 'Component = frmODBase' 113 'Status = stsDefault')) 114 end 94 115 end -
cprs/trunk/CPRS-Chart/Orders/fODBase.pas
r456 r829 8 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fAutoSz, StdCtrls, 9 9 ORCtrls, ORFn, uConst, rOrders, rODBase, uCore, ComCtrls, ExtCtrls, Menus, Mask, 10 Buttons, UBAGlobals, UBACore ;10 Buttons, UBAGlobals, UBACore, VA508AccessibilityManager; 11 11 12 12 type … … 182 182 procedure SetDialogIEN(Value: Integer); virtual; 183 183 procedure Validate(var AnErrMsg: string); virtual; 184 procedure updateSig; virtual; 184 185 function ValidSave: Boolean; 185 186 procedure ShowOrderMessage(Show: boolean); … … 221 222 222 223 var 223 frmODBase: TfrmODBase ;224 frmODBase: TfrmODBase = nil; 224 225 XfInToOutNow :boolean = False; // it's used only for transfering Inpatient Meds to OutPatient Med for 225 226 // immediately release (NO EVENT DELAY) … … 246 247 uses fOCAccept, uODBase, rCore, rMisc, fODMessage, 247 248 fTemplateDialog, uEventHooks, uTemplates, rConsults,fOrders,uOrders, 248 fFrame, uTemplateFields, fClinicWardMeds ;249 fFrame, uTemplateFields, fClinicWardMeds, fODDietLT, rODDiet, VAUtils; 249 250 250 251 const … … 425 426 else if AControl is TButton then with TButton(AControl) do Caption := CtrlInit.Text 426 427 else if AControl is TEdit then with TEdit(AControl) do Text := CtrlInit.Text 427 else if AControl is TMemo then with TMemo(AControl) do Lines.Assign(CtrlInit.List)428 else if AControl is TRichEdit then with TRichEdit(AControl) do Lines.Assign(CtrlInit.List)429 else if AControl is TORListBox then with TORListBox(AControl) do Items.Assign(CtrlInit.List)430 else if AControl is TListBox then with TListBox(AControl) do Items.Assign(CtrlInit.List)428 else if AControl is TMemo then FastAssign(CtrlInit.List, TMemo(AControl).Lines) 429 else if AControl is TRichEdit then QuickCopy(CtrlInit.List, TRichEdit(AControl)) 430 else if AControl is TORListBox then FastAssign(CtrlInit.List, TORListBox(AControl).Items) 431 else if AControl is TListBox then FastAssign(CtrlInit.List, TListBox(AControl).Items) 431 432 else if AControl is TComboBox then with TComboBox(AControl) do 432 433 begin 433 Items.Assign(CtrlInit.List);434 FastAssign(CtrlInit.List, TComboBox(AControl).Items); 434 435 Text := CtrlInit.Text; 435 436 end 436 437 else if AControl is TORComboBox then with TORComboBox(AControl) do 437 438 begin 438 Items.Assign(CtrlInit.List);439 FastAssign(CtrlInit.List, TORComboBox(AControl).Items); 439 440 if LongList then InitLongList(Text) else Text := CtrlInit.Text; 440 441 SelectByID(CtrlInit.ListID); … … 450 451 CtrlInit := FindInitByName(ASection); 451 452 if CtrlInit = nil then Exit; 452 if AControl is TMemo then with TMemo(AControl) do Lines.Assign(CtrlInit.List)453 else if AControl is TORListBox then with TORListBox(AControl) do Items.Assign(CtrlInit.List)454 else if AControl is TListBox then with TListBox(AControl) do Items.Assign(CtrlInit.List)455 else if AControl is TComboBox then with TComboBox(AControl) do Items.Assign(CtrlInit.List)456 else if AControl is TORComboBox then with TORComboBox(AControl) do Items.Assign(CtrlInit.List);453 if AControl is TMemo then FastAssign(CtrlInit.List, TMemo(AControl).Lines) 454 else if AControl is TORListBox then FastAssign(CtrlInit.List, TORListBox(AControl).Items) 455 else if AControl is TListBox then FastAssign(CtrlInit.List, TListBox(AControl).Items) 456 else if AControl is TComboBox then FastAssign(CtrlInit.List, TComboBox(AControl).Items) 457 else if AControl is TORComboBox then FastAssign(CtrlInit.List, TORComboBox(AControl).Items); 457 458 end; 458 459 … … 1028 1029 //AGP Text orders are only treated as IMO if the order display group is a nursing display group 1029 1030 if (Patient.Inpatient = False) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and 1030 (((pos('OR GXTEXT WORD PROCESSING ORDE ',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or1031 (((pos('OR GXTEXT WORD PROCESSING ORDER',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or 1031 1032 ((ConstructOrder.DialogName = 'OR GXMISC GENERAL') and (ConstructOrder.DGroup = NurDisp)) or 1032 1033 ((ConstructOrder.DialogName = 'OR GXTEXT TEXT ONLY ORDER') and (ConstructOrder.DGroup = NurDisp))) and //AGP Change CQ #10757 … … 1144 1145 // CheckBoilerplate4Fields(tmp, cptn) 1145 1146 //else 1146 ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, nil, cptn, DocInfo); 1147 1148 // CQ #11669 - changing an existing order shouldn't restart template - JM 1149 if assigned(frmODBase) and (frmODBase.FOrderAction = ORDER_EDIT) then 1150 CheckBoilerplate4Fields(tmp, cptn) 1151 else 1152 ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, nil, cptn, DocInfo); 1147 1153 end 1148 1154 else … … 1391 1397 begin 1392 1398 inherited; 1393 memOrder.Color := ReadOnlyColor;1399 frmODBase := Self; 1394 1400 FAcceptOK := False; 1395 1401 FAutoAccept := False; … … 1420 1426 FEvtType := OrderEventTypeOnCreate; 1421 1427 FEvtName := OrderEventNameOnCreate; 1428 DefaultButton := cmdAccept; 1422 1429 end; 1423 1430 1424 1431 procedure TfrmODBase.FormDestroy(Sender: TObject); 1425 1432 begin 1433 frmODBase := nil; 1426 1434 FCtrlInits.Free; 1427 1435 FResponses.Free; … … 1478 1486 NewOrder: TOrder; 1479 1487 CanSign, OrderAction: Integer; 1488 IsDelayOrder: boolean; 1480 1489 //thisSourceOrder: TOrder; 1481 1490 begin 1482 1491 Result := True; 1483 1492 Validate(ErrMsg); 1493 IsDelayOrder := False; 1484 1494 if Length(ErrMsg) > 0 then 1485 1495 begin … … 1531 1541 else CanSign := CH_SIGN_NA; 1532 1542 if NewOrder.Signature = OSS_NOT_REQUIRE then CanSign := CH_SIGN_NA; 1533 Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign); 1543 if NewOrder.EventPtr <> '' then IsDelayOrder := True; 1544 Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False,IsDelayOrder); 1534 1545 1535 1546 UBAGlobals.TargetOrderID := NewOrder.ID; … … 1558 1569 theGrpName: string; 1559 1570 alreadyClosed: boolean; 1571 LateTrayFields: TLateTrayFields; 1572 x, CxMsg: string; 1560 1573 begin 1561 1574 FAcceptOK := False; … … 1571 1584 end; 1572 1585 end; 1586 1587 // check for diet orders that will be auto-DCd because of start/stop overlaps 1588 if Responses.Dialog = 'FHW1' then 1589 begin 1590 if (Self.EvtID <> 0) then 1591 begin 1592 CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, '', CxMsg, cmdAccept); 1593 if CxMsg <> '' then 1594 begin 1595 if InfoBox(CxMsg + CRLF + CRLF + 1596 'Have you done either of the above?', 'Possible delayed order conflict', 1597 MB_ICONWARNING or MB_YESNO) = ID_NO 1598 then exit; 1599 end; 1600 end 1601 else if FAutoAccept then 1602 begin 1603 x := CurrentDietText; 1604 CheckForAutoDCDietOrders(0, Self.DisplayGroup, x, CxMsg, nil); 1605 if CxMsg <> '' then 1606 begin 1607 if InfoBox(CxMsg + CRLF + 1608 'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = ID_NO then 1609 begin 1610 //AbortOrder := True; 1611 FAcceptOK := FALSE; 1612 //cmdQuitClick(Self); 1613 exit; 1614 end; 1615 end; 1616 end; 1617 end; 1618 1573 1619 if ValidSave then 1574 1620 begin … … 1581 1627 else 1582 1628 begin 1629 LateTrayFields.LateMeal := #0; 1630 with Responses do 1631 if FAutoAccept and ((Dialog = 'FHW1') or (Dialog = 'FHW OP MEAL') or (Dialog ='FHW SPECIAL MEAL')) then 1632 begin 1633 LateTrayCheck(Responses, Self.EvtID, not OrderForInpatient, LateTrayFields); 1634 end; 1583 1635 ClearDialogControls; // to allow form to close without prompting to save order 1636 with LateTrayFields do if LateMeal <> #0 then LateTrayOrder(LateTrayFields, OrderForInpatient); 1584 1637 Close; 1585 1638 alreadyClosed := True; … … 1627 1680 begin 1628 1681 inherited; 1682 FFromQuit := True; 1629 1683 Close; 1630 1684 end; … … 1665 1719 exit; 1666 1720 end; 1721 if FFromQuit = False then updateSig; 1667 1722 if Length(memOrder.Text) > 0 then 1668 1723 begin … … 1681 1736 if not ValidSave then CanClose := False; 1682 1737 if CanClose then InitDialog; 1738 end; 1739 1740 procedure TfrmODBase.updateSig; 1741 begin 1742 1683 1743 end; 1684 1744 … … 1785 1845 if Length(TempMSG)>0 then 1786 1846 begin 1787 ShowM essage(TempMSG);1847 ShowMsg(TempMSG); 1788 1848 Result := False; 1789 1849 end; -
cprs/trunk/CPRS-Chart/Orders/fODChangeEvtDisp.dfm
r456 r829 1 objectfrmChangeEventDisp: TfrmChangeEventDisp1 inherited frmChangeEventDisp: TfrmChangeEventDisp 2 2 Left = 344 3 3 Top = 230 4 Width = 4085 Height = 4446 4 Caption = 'Change release event' 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 = [] 5 ClientHeight = 417 6 ClientWidth = 400 13 7 OldCreateOrder = False 14 8 Position = poDesktopCenter 9 ExplicitWidth = 408 10 ExplicitHeight = 444 15 11 PixelsPerInch = 96 16 12 TextHeight = 13 17 object lblTop: TMemo 13 object lblTop: TMemo [0] 18 14 Left = 0 19 15 Top = 0 … … 27 23 TabOrder = 2 28 24 end 29 object pnlTop: TPanel 25 object pnlTop: TPanel [1] 30 26 Left = 0 31 27 Top = 37 … … 40 36 Width = 394 41 37 Height = 333 38 Style = lbOwnerDrawVariable 42 39 Align = alClient 43 40 ItemHeight = 13 44 Style = lbOwnerDrawVariable45 41 TabOrder = 0 46 42 OnDrawItem = lstCVOrdersDrawItem … … 48 44 end 49 45 end 50 object pnlBottom: TPanel 46 object pnlBottom: TPanel [2] 51 47 Left = 0 52 48 Top = 376 … … 55 51 Align = alBottom 56 52 TabOrder = 1 53 DesignSize = ( 54 400 55 41) 57 56 object cmdOK: TButton 58 57 Left = 230 … … 76 75 end 77 76 end 77 inherited amgrMain: TVA508AccessibilityManager 78 Data = ( 79 ( 80 'Component = lblTop' 81 'Status = stsDefault') 82 ( 83 'Component = pnlTop' 84 'Status = stsDefault') 85 ( 86 'Component = lstCVOrders' 87 'Status = stsDefault') 88 ( 89 'Component = pnlBottom' 90 'Status = stsDefault') 91 ( 92 'Component = cmdOK' 93 'Status = stsDefault') 94 ( 95 'Component = cmdCancel' 96 'Status = stsDefault') 97 ( 98 'Component = frmChangeEventDisp' 99 'Status = stsDefault')) 100 end 78 101 end -
cprs/trunk/CPRS-Chart/Orders/fODChangeEvtDisp.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ExtCtrls, ORCtrls ;7 fAutoSz, StdCtrls, ORFn, ExtCtrls, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type … … 64 64 begin 65 65 Canvas.FillRect(ARect); 66 Canvas.Pen.Color := clSilver;66 Canvas.Pen.Color := Get508CompliantColor(clSilver); 67 67 Canvas.MoveTo(0, ARect.Bottom - 1); 68 68 Canvas.LineTo(ARect.Right, ARect.Bottom - 1); -
cprs/trunk/CPRS-Chart/Orders/fODChangeUnreleasedRenew.dfm
r456 r829 1 objectfrmODChangeUnreleasedRenew: TfrmODChangeUnreleasedRenew1 inherited frmODChangeUnreleasedRenew: TfrmODChangeUnreleasedRenew 2 2 Left = 240 3 3 Top = 163 4 Width = 5375 Height = 1986 4 Caption = 'Change Unreleased Renewed Order' 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 = [] 5 ClientHeight = 171 6 ClientWidth = 529 13 7 OldCreateOrder = False 14 8 OnCreate = FormCreate 9 ExplicitWidth = 537 10 ExplicitHeight = 198 15 11 PixelsPerInch = 96 16 12 TextHeight = 13 17 object Panel2: TPanel 13 object Panel2: TPanel [0] 18 14 Left = 0 19 15 Top = 57 20 16 Width = 529 21 Height = 8 117 Height = 82 22 18 Align = alClient 23 19 TabOrder = 0 20 ExplicitHeight = 81 24 21 object lblRefill: TLabel 25 22 Left = 9 … … 63 60 SynonymChars = '<>' 64 61 TabOrder = 1 62 CharsNeedMatch = 1 65 63 end 66 64 end 67 object Panel3: TPanel 65 object Panel3: TPanel [1] 68 66 Left = 0 69 67 Top = 57 70 68 Width = 529 71 Height = 8 169 Height = 82 72 70 Align = alClient 73 71 TabOrder = 3 72 ExplicitHeight = 81 74 73 object Label1: TLabel 75 74 Left = 61 … … 107 106 end 108 107 end 109 object memOrder: TCaptionMemo 108 object memOrder: TCaptionMemo [2] 110 109 Left = 0 111 110 Top = 0 … … 122 121 TabOrder = 2 123 122 end 124 object Panel1: TPanel 123 object Panel1: TPanel [3] 125 124 Left = 0 126 Top = 13 8125 Top = 139 127 126 Width = 529 128 127 Height = 32 129 128 Align = alBottom 130 129 TabOrder = 1 130 ExplicitTop = 138 131 131 object btnOK: TButton 132 132 Left = 348 … … 148 148 end 149 149 end 150 inherited amgrMain: TVA508AccessibilityManager 151 Data = ( 152 ( 153 'Component = Panel2' 154 'Status = stsDefault') 155 ( 156 'Component = edtRefill' 157 'Status = stsDefault') 158 ( 159 'Component = cboPickup' 160 'Status = stsDefault') 161 ( 162 'Component = Panel3' 163 'Status = stsDefault') 164 ( 165 'Component = txtStart' 166 'Status = stsDefault') 167 ( 168 'Component = txtStop' 169 'Status = stsDefault') 170 ( 171 'Component = memOrder' 172 'Status = stsDefault') 173 ( 174 'Component = Panel1' 175 'Status = stsDefault') 176 ( 177 'Component = btnOK' 178 'Status = stsDefault') 179 ( 180 'Component = btnCancel' 181 'Status = stsDefault') 182 ( 183 'Component = frmODChangeUnreleasedRenew' 184 'Status = stsDefault')) 185 end 150 186 end -
cprs/trunk/CPRS-Chart/Orders/fODChangeUnreleasedRenew.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders; 7 Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders, 8 VA508AccessibilityManager; 8 9 9 10 type -
cprs/trunk/CPRS-Chart/Orders/fODChild.dfm
r456 r829 1 objectfrmODChild: TfrmODChild1 inherited frmODChild: TfrmODChild 2 2 Left = 433 3 3 Top = 271 4 Width = 5125 Height = 4536 4 Caption = 'Associated Complex Orders' 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 = [] 5 ClientHeight = 426 6 ClientWidth = 504 13 7 OldCreateOrder = False 14 8 Position = poMainFormCenter 15 9 OnCreate = FormCreate 10 ExplicitWidth = 512 11 ExplicitHeight = 453 16 12 PixelsPerInch = 96 17 13 TextHeight = 13 18 object lblWarning: TLabel 14 object lblWarning: TLabel [0] 19 15 Left = 0 20 16 Top = 0 … … 30 26 WordWrap = True 31 27 end 32 object Panel1: TPanel 28 object Panel1: TPanel [1] 33 29 Left = 0 34 30 Top = 59 35 31 Width = 504 36 Height = 32 532 Height = 326 37 33 Align = alClient 38 34 BevelOuter = bvNone … … 44 40 Top = 3 45 41 Width = 494 46 Height = 31 542 Height = 316 47 43 Style = lbOwnerDrawVariable 48 44 Align = alClient … … 53 49 end 54 50 end 55 object Panel2: TPanel 51 object Panel2: TPanel [2] 56 52 Left = 0 57 Top = 38 453 Top = 385 58 54 Width = 504 59 55 Height = 41 … … 84 80 end 85 81 end 82 inherited amgrMain: TVA508AccessibilityManager 83 Data = ( 84 ( 85 'Component = Panel1' 86 'Status = stsDefault') 87 ( 88 'Component = lstODComplex' 89 'Status = stsDefault') 90 ( 91 'Component = Panel2' 92 'Status = stsDefault') 93 ( 94 'Component = btnOK' 95 'Status = stsDefault') 96 ( 97 'Component = btnCancel' 98 'Status = stsDefault') 99 ( 100 'Component = frmODChild' 101 'Status = stsDefault')) 102 end 86 103 end -
cprs/trunk/CPRS-Chart/Orders/fODChild.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ExtCtrls, StdCtrls, fAutoSZ, ORFn ;7 ExtCtrls, StdCtrls, fAutoSZ, ORFn, VA508AccessibilityManager; 8 8 9 9 type … … 83 83 ARect.Left := ARect.Left + 2; 84 84 Canvas.FillRect(ARect); 85 Canvas.Pen.Color := clSilver;85 Canvas.Pen.Color := Get508CompliantColor(clSilver); 86 86 SaveColor := Canvas.Brush.Color; 87 87 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); -
cprs/trunk/CPRS-Chart/Orders/fODDiet.dfm
r456 r829 5 5 Height = 291 6 6 Caption = 'Diet Order' 7 OnKeyDown = FormKeyDown 7 ExplicitWidth = 532 8 ExplicitHeight = 291 8 9 PixelsPerInch = 96 9 10 TextHeight = 13 … … 15 16 ActivePage = pgeOutPt 16 17 Align = alTop 17 TabIndex = 118 18 TabOrder = 4 19 19 TabStop = False … … 998 998 inherited memOrder: TCaptionMemo 999 999 Top = 208 1000 ExplicitTop = 208 1000 1001 end 1001 1002 inherited cmdAccept: TButton … … 1003 1004 Top = 208 1004 1005 TabOrder = 2 1006 ExplicitLeft = 445 1007 ExplicitTop = 208 1005 1008 end 1006 1009 inherited cmdQuit: TButton … … 1008 1011 Top = 235 1009 1012 TabOrder = 3 1013 ExplicitLeft = 445 1014 ExplicitTop = 235 1010 1015 end 1011 1016 inherited pnlMessage: TPanel … … 1013 1018 Height = 57 1014 1019 TabOrder = 1 1020 ExplicitTop = 197 1021 ExplicitHeight = 57 1015 1022 inherited imgMessage: TImage 1016 1023 Top = 10 1024 ExplicitTop = 10 1017 1025 end 1018 1026 inherited memMessage: TRichEdit 1019 1027 Height = 45 1028 ExplicitHeight = 45 1020 1029 end 1021 1030 end 1031 inherited amgrMain: TVA508AccessibilityManager 1032 Data = ( 1033 ( 1034 'Component = nbkDiet' 1035 'Status = stsDefault') 1036 ( 1037 'Component = pgeDiet' 1038 'Status = stsDefault') 1039 ( 1040 'Component = cboDietAvail' 1041 'Status = stsDefault') 1042 ( 1043 'Component = lstDietSelect' 1044 'Status = stsDefault') 1045 ( 1046 'Component = cmdRemove' 1047 'Status = stsDefault') 1048 ( 1049 'Component = txtDietComment' 1050 'Status = stsDefault') 1051 ( 1052 'Component = calDietStart' 1053 'Status = stsDefault') 1054 ( 1055 'Component = calDietStop' 1056 'Status = stsDefault') 1057 ( 1058 'Component = cboDelivery' 1059 'Status = stsDefault') 1060 ( 1061 'Component = chkCancelTubefeeding' 1062 'Status = stsDefault') 1063 ( 1064 'Component = pgeOutPt' 1065 'Status = stsDefault') 1066 ( 1067 'Component = grpOPMeal' 1068 'Status = stsDefault') 1069 ( 1070 'Component = grpOPDoW' 1071 'Status = stsDefault') 1072 ( 1073 'Component = chkOPMonday' 1074 'Status = stsDefault') 1075 ( 1076 'Component = chkOPTuesday' 1077 'Status = stsDefault') 1078 ( 1079 'Component = chkOPWednesday' 1080 'Status = stsDefault') 1081 ( 1082 'Component = chkOPThursday' 1083 'Status = stsDefault') 1084 ( 1085 'Component = chkOPFriday' 1086 'Status = stsDefault') 1087 ( 1088 'Component = chkOPSaturday' 1089 'Status = stsDefault') 1090 ( 1091 'Component = chkOPSunday' 1092 'Status = stsDefault') 1093 ( 1094 'Component = calOPStart' 1095 'Status = stsDefault') 1096 ( 1097 'Component = calOPStop' 1098 'Status = stsDefault') 1099 ( 1100 'Component = cboOPDietAvail' 1101 'Status = stsDefault') 1102 ( 1103 'Component = txtOPDietComment' 1104 'Status = stsDefault') 1105 ( 1106 'Component = cboOPDelivery' 1107 'Status = stsDefault') 1108 ( 1109 'Component = lstOPDietSelect' 1110 'Status = stsDefault') 1111 ( 1112 'Component = cmdOPRemove' 1113 'Status = stsDefault') 1114 ( 1115 'Component = chkOPCancelTubefeeding' 1116 'Status = stsDefault') 1117 ( 1118 'Component = pgeTubefeeding' 1119 'Status = stsDefault') 1120 ( 1121 'Component = cboProduct' 1122 'Status = stsDefault') 1123 ( 1124 'Component = txtTFComment' 1125 'Status = stsDefault') 1126 ( 1127 'Component = grdSelected' 1128 'Status = stsDefault') 1129 ( 1130 'Component = cmdTFRemove' 1131 'Status = stsDefault') 1132 ( 1133 'Component = chkCancelTrays' 1134 'Status = stsDefault') 1135 ( 1136 'Component = txtQuantity' 1137 'Status = stsDefault') 1138 ( 1139 'Component = cboStrength' 1140 'Status = stsDefault') 1141 ( 1142 'Component = calOPTFStart' 1143 'Status = stsDefault') 1144 ( 1145 'Component = cboOPTFRecurringMeals' 1146 'Status = stsDefault') 1147 ( 1148 'Component = pgeEarlyLate' 1149 'Status = stsDefault') 1150 ( 1151 'Component = grpMeal' 1152 'Status = stsDefault') 1153 ( 1154 'Component = grpMealTime' 1155 'Status = stsDefault') 1156 ( 1157 'Component = radET1' 1158 'Status = stsDefault') 1159 ( 1160 'Component = radET2' 1161 'Status = stsDefault') 1162 ( 1163 'Component = radET3' 1164 'Status = stsDefault') 1165 ( 1166 'Component = radLT1' 1167 'Status = stsDefault') 1168 ( 1169 'Component = radLT2' 1170 'Status = stsDefault') 1171 ( 1172 'Component = radLT3' 1173 'Status = stsDefault') 1174 ( 1175 'Component = calELStart' 1176 'Status = stsDefault') 1177 ( 1178 'Component = calELStop' 1179 'Status = stsDefault') 1180 ( 1181 'Component = grpDoW' 1182 'Status = stsDefault') 1183 ( 1184 'Component = chkMonday' 1185 'Status = stsDefault') 1186 ( 1187 'Component = chkTuesday' 1188 'Status = stsDefault') 1189 ( 1190 'Component = chkWednesday' 1191 'Status = stsDefault') 1192 ( 1193 'Component = chkThursday' 1194 'Status = stsDefault') 1195 ( 1196 'Component = chkFriday' 1197 'Status = stsDefault') 1198 ( 1199 'Component = chkSaturday' 1200 'Status = stsDefault') 1201 ( 1202 'Component = chkSunday' 1203 'Status = stsDefault') 1204 ( 1205 'Component = chkBagged' 1206 'Status = stsDefault') 1207 ( 1208 'Component = cboOPELRecurringMeals' 1209 'Status = stsDefault') 1210 ( 1211 'Component = pgeIsolations' 1212 'Status = stsDefault') 1213 ( 1214 'Component = lstIsolation' 1215 'Status = stsDefault') 1216 ( 1217 'Component = txtIPComment' 1218 'Status = stsDefault') 1219 ( 1220 'Component = txtIPCurrent' 1221 'Status = stsDefault') 1222 ( 1223 'Component = pgeAdditional' 1224 'Status = stsDefault') 1225 ( 1226 'Component = txtAOComment' 1227 'Status = stsDefault') 1228 ( 1229 'Component = calOPAOStart' 1230 'Status = stsDefault') 1231 ( 1232 'Component = cboOPAORecurringMeals' 1233 'Status = stsDefault') 1234 ( 1235 'Component = memOrder' 1236 'Status = stsDefault') 1237 ( 1238 'Component = cmdAccept' 1239 'Status = stsDefault') 1240 ( 1241 'Component = cmdQuit' 1242 'Status = stsDefault') 1243 ( 1244 'Component = pnlMessage' 1245 'Status = stsDefault') 1246 ( 1247 'Component = memMessage' 1248 'Status = stsDefault') 1249 ( 1250 'Component = frmODDiet' 1251 'Status = stsDefault')) 1252 end 1022 1253 end -
cprs/trunk/CPRS-Chart/Orders/fODDiet.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst; 7 fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst, 8 VA508AccessibilityManager; 8 9 9 10 type … … 161 162 FIsolationID: string; 162 163 FTabChanging: Boolean; 164 FGiveMultiTabMessage: boolean; 163 165 procedure DietCheckForNPO; 164 166 procedure DietCheckForTF; … … 192 194 procedure OPDietCheckForNPO; 193 195 procedure OPDietCheckForTF; 194 function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean; 196 function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean; 197 //procedure CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject); 195 198 protected 196 199 procedure InitDialog; override; … … 210 213 {$R *.DFM} 211 214 212 uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid, DateUtils; 215 uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, DateUtils, 216 fOrders, uODBase, VA508AccessibilityRouter; 213 217 214 218 const … … 314 318 begin 315 319 inherited; 320 FGiveMultiTabMessage := ScreenReaderSystemActive; 316 321 AbortOrder := False; 317 322 uRecurringMealList := TStringList.Create; … … 366 371 end; 367 372 end; 368 TAccessibleStringGrid.WrapControl(grdSelected);369 373 end; 370 374 371 375 procedure TfrmODDiet.FormDestroy(Sender: TObject); 372 376 begin 373 TAccessibleStringGrid.UnwrapControl(grdSelected);374 377 TFClearGrid; 375 378 uRecurringMealList.Free; … … 667 670 end; 668 671 669 procedure TfrmODDiet.nbkDietChange(Sender: TObject); 670 var 671 x, CxMsg: string ; 672 i: integer; 673 AStringList: TStringList; 672 (*procedure TfrmODDiet.CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject); 674 673 const 675 // TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet:' + CRLF + CRLF;676 674 TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF + 677 675 'you specify a start date for when the new diet should replace the current' + CRLF + 678 676 'diet:' + CRLF + CRLF; 679 677 TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF; 678 TX_CX_DELAYED1 = 'There are other delayed diet orders for this release event:'; 679 TX_CX_DELAYED2 = 'This new diet order may cancel and replace those other diets' + CRLF + 680 'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF + 681 682 '1. Specify an expiration date/time for this order that will' + CRLF + 683 ' be prior to the start date/time of those other orders; or' + CRLF + CRLF + 684 685 '2. Specify a later start date/time for this order for when you' + CRLF + 686 ' would like it to cancel and replace those other orders.'; 687 688 var 689 i: integer; 690 AStringList: TStringList; 691 AList: TList; 692 x, PtEvtIFN, PtEvtName: string; 693 //AResponse: TResponse; 694 begin 695 if Self.EvtID = 0 then // check current and future released diets 696 begin 697 x := CurrentText; 698 if Piece(x, #13, 1) <> 'Current Diet: ' then 699 begin 700 AStringList := TStringList.Create; 701 try 702 AStringList.Text := x; 703 CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF 704 + #9 + Copy(AStringList[0], 16, 99) + CRLF; 705 if AStringList.Count > 1 then 706 begin 707 CancelText := CancelText + CRLF + CRLF + 708 TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF 709 + #9 + Copy(AStringList[1], 22, 99) + CRLF; 710 if AStringList.Count > 2 then 711 for i := 2 to AStringList.Count - 1 do 712 CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF; 713 end; 714 finally 715 AStringList.Free; 716 end; 717 end; 718 end 719 else if Sender is TButton then // delayed orders code here - on accept only 720 begin 721 //AResponse := Responses.FindResponseByName('STOP', 1); 722 //if (AResponse <> nil) and (AResponse.EValue <> '') then exit; 723 AList := TList.Create; 724 try 725 PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN); 726 PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName; 727 LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN); 728 for i := AList.Count - 1 downto 0 do 729 begin 730 if TOrder(Alist.Items[i]).DGroup <> Self.DisplayGroup then 731 begin 732 TOrder(AList.Items[i]).Free; 733 AList.Delete(i); 734 end; 735 end; 736 if AList.Count > 0 then 737 begin 738 x := ''; 739 RetrieveOrderFields(AList, 0, 0); 740 CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName; 741 for i := 0 to AList.Count - 1 do 742 with TOrder(AList.Items[i]) do 743 begin 744 x := x + #9 + Text + CRLF; 745 (* if StartTime <> '' then 746 x := #9 + x + 'Start: ' + StartTime + CRLF 747 else 748 x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*) 749 (* end; 750 CancelText := CancelText + CRLF + CRLF + x; 751 CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2; 752 end; 753 finally 754 with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free; 755 AList.Free; 756 end; 757 end; 758 end;*) 759 760 procedure TfrmODDiet.nbkDietChange(Sender: TObject); 761 var 762 x: string ; 763 CxMsg: string; 680 764 begin 681 765 inherited; … … 693 777 AllowQuickOrder := True; 694 778 x := CurrentDietText; 695 if Piece(x, #13, 1) <> 'Current Diet: ' then 696 begin 697 AStringList := TStringList.Create; 698 try 699 AStringList.Text := x; 700 CxMsg := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF 701 + #9 + Copy(AStringList[0], 16, 99) + CRLF; 702 if AStringList.Count > 1 then 703 begin 704 CxMsg := CxMsg + CRLF + CRLF + 705 TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF 706 + #9 + Copy(AStringList[1], 22, 99) + CRLF; 707 if AStringList.Count > 2 then 708 for i := 2 to AStringList.Count - 1 do 709 CxMsg := CxMsg + #9 + TrimLeft(AStringList[i]) + CRLF; 710 end; 711 finally 712 AStringList.Free; 713 end; 714 end; 779 CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, x, CxMsg, nbkDiet); 715 780 if CxMsg <> '' then 716 781 begin … … 745 810 end 746 811 else 747 cboOPTFRecurringMeals.Items.Assign(uRecurringMealList);812 FastAssign(uRecurringMealList, cboOPTFRecurringMeals.Items); 748 813 end; 749 814 cboOPTFRecurringMeals.Visible := not OrderForInpatient; … … 781 846 end 782 847 else 783 cboOPELRecurringMeals.Items.Assign(uRecurringMealList);848 FastAssign(uRecurringMealList, cboOPELRecurringMeals.Items); 784 849 end 785 850 else if (StrToIntDef(uDietParams.EarlyIEN, 0) = 0) or (StrToIntDef(uDietParams.LateIEN, 0) = 0) then … … 828 893 end 829 894 else 830 cboOPAORecurringMeals.Items.Assign(uRecurringMealList);895 FastAssign(uRecurringMealList, cboOPAORecurringMeals.Items); 831 896 end; 832 897 cboOPAORecurringMeals.Visible := not OrderForInpatient; … … 854 919 AllowQuickOrder := False; 855 920 ResetControlsOP; 856 cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);921 FastAddStrings(SubsetOfOPDiets, cboOPDietAvail.Items); 857 922 { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? } 858 923 chkOPCancelTubefeeding.State := cbGrayed; … … 873 938 LoadDietQuickList(cboOPDietAvail.Items, 'MEAL'); // use D.G. short name here 874 939 cboOPDietAvail.InsertSeparator; 875 cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);940 FastAddStrings(SubsetOfOPDiets, cboOPDietAvail.Items); 876 941 cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet); 877 942 { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? } … … 886 951 Changing := False; // Changing reset 887 952 StatusText(''); 953 if FGiveMultiTabMessage then // CQ#15483 954 begin 955 FGiveMultiTabMessage := FALSE; 956 GetScreenReader.Speak('Multi Tab Form'); 957 end; 888 958 end; 889 959 … … 1615 1685 end 1616 1686 else 1617 cboOPELRecurringMeals.Items.Assign(uRecurringMealList);1687 FastAssign(uRecurringMealList, cboOPELRecurringMeals.Items); 1618 1688 end; 1619 1689 Changing := False; … … 2142 2212 var 2143 2213 DCOrder: TOrder; 2144 AResponse, AnotherResponse: TResponse;2145 2214 LateTrayFields: TLateTrayFields; 2146 NewOrder: TOrder; 2147 CanSign: Integer; 2215 //CxMsg: string; 2148 2216 begin 2149 2217 // these actions should be before inherited, so that InitDialog doesn't clear properties … … 2151 2219 if nbkDiet.ActivePage = pgeDiet then 2152 2220 begin 2221 (* if Self.EvtID <> 0 then 2222 begin 2223 CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, '', CxMsg, cmdAccept); 2224 if CxMsg <> '' then 2225 begin 2226 if InfoBox(CxMsg + CRLF + CRLF + 2227 'Have you done either of the above?', 'Possible delayed order conflict', 2228 MB_ICONWARNING or MB_YESNO) = ID_NO 2229 then exit; 2230 end; 2231 end;*) 2153 2232 // create dc tubefeeding order 2154 2233 if chkCancelTubeFeeding.State = cbChecked then … … 2160 2239 end; 2161 2240 // check if late tray should be ordered 2162 AResponse := Responses.FindResponseByName('ORDERABLE', 1); 2163 if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then 2164 begin 2165 AResponse := Responses.FindResponseByName('START', 1); 2166 if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False); 2167 end; 2241 LateTrayCheck(Responses, Self.EvtID, FALSE, LateTrayFields); 2168 2242 end; 2169 2243 { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? } … … 2179 2253 end; 2180 2254 // check if late tray should be ordered 2181 AResponse := Responses.FindResponseByName('ORDERABLE', 1); 2182 if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then 2183 begin 2184 AResponse := Responses.FindResponseByName('START', 1); 2185 AnotherResponse := Responses.FindResponseByName('MEAL', 1); 2186 if (AResponse <> nil) and (AnotherResponse <> nil) then 2187 CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1)); 2188 end; 2189 end; 2190 inherited; 2191 with LateTrayFields do if LateMeal <> #0 then 2192 begin 2193 NewOrder := TOrder.Create; 2194 OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged); 2195 if NewOrder.ID <> '' then 2196 begin 2197 if OrderForInpatient then 2198 begin 2199 if (Encounter.Provider = User.DUZ) and User.CanSignOrders 2200 then CanSign := CH_SIGN_YES 2201 else CanSign := CH_SIGN_NA; 2202 end 2203 else 2204 begin 2205 CanSign := CH_SIGN_NA; 2206 end; 2207 Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign); 2208 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder)) 2209 end 2210 else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK); 2211 NewOrder.Free; 2212 end; 2255 LateTrayCheck(Responses, Self.EvtID, TRUE, LateTrayFields); 2256 end; 2257 inherited; 2258 with LateTrayFields do if LateMeal <> #0 then LateTrayOrder(LateTrayFields, OrderForInpatient); 2213 2259 end; 2214 2260 -
cprs/trunk/CPRS-Chart/Orders/fODDietLT.dfm
r456 r829 2 2 Left = 398 3 3 Top = 254 4 Width = 3045 Height = 1886 4 Caption = 'Late Tray?' 5 ClientHeight = 161 6 ClientWidth = 296 7 7 Position = poScreenCenter 8 8 OnCreate = FormCreate 9 ExplicitWidth = 304 10 ExplicitHeight = 188 9 11 PixelsPerInch = 96 10 12 TextHeight = 13 11 object Bevel1: TBevel 13 object Bevel1: TBevel [0] 12 14 Left = 0 13 15 Top = 66 … … 15 17 Height = 2 16 18 end 17 object lblMealCutoff: TStaticText 19 object lblMealCutoff: TStaticText [1] 18 20 Left = 8 19 21 Top = 16 … … 23 25 TabOrder = 4 24 26 end 25 object Label2: TStaticText 27 object Label2: TStaticText [2] 26 28 Left = 8 27 29 Top = 34 … … 31 33 TabOrder = 5 32 34 end 33 object GroupBox1: TGroupBox 35 object GroupBox1: TGroupBox [3] 34 36 Left = 109 35 37 Top = 76 … … 60 62 end 61 63 end 62 object cmdYes: TButton 64 object cmdYes: TButton [4] 63 65 Left = 216 64 66 Top = 8 … … 70 72 OnClick = cmdYesClick 71 73 end 72 object cmdNo: TButton 74 object cmdNo: TButton [5] 73 75 Left = 216 74 76 Top = 37 … … 80 82 OnClick = cmdNoClick 81 83 end 82 object chkBagged: TCheckBox 84 object chkBagged: TCheckBox [6] 83 85 Left = 8 84 86 Top = 76 … … 88 90 TabOrder = 3 89 91 end 92 inherited amgrMain: TVA508AccessibilityManager 93 Data = ( 94 ( 95 'Component = lblMealCutoff' 96 'Status = stsDefault') 97 ( 98 'Component = Label2' 99 'Status = stsDefault') 100 ( 101 'Component = GroupBox1' 102 'Status = stsDefault') 103 ( 104 'Component = radLT1' 105 'Status = stsDefault') 106 ( 107 'Component = radLT2' 108 'Status = stsDefault') 109 ( 110 'Component = radLT3' 111 'Status = stsDefault') 112 ( 113 'Component = cmdYes' 114 'Status = stsDefault') 115 ( 116 'Component = cmdNo' 117 'Status = stsDefault') 118 ( 119 'Component = chkBagged' 120 'Status = stsDefault') 121 ( 122 'Component = frmODDietLT' 123 'Status = stsDefault')) 124 end 90 125 end -
cprs/trunk/CPRS-Chart/Orders/fODDietLT.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, ExtCtrls, StdCtrls, ORFn ;7 fAutoSz, ExtCtrls, StdCtrls, ORFn, fODBase, rODBase, VA508AccessibilityManager; 8 8 9 9 type … … 36 36 37 37 procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0); 38 procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields); 39 procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean); 38 40 39 41 implementation … … 192 194 end; 193 195 196 procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields); 197 var 198 AResponse, AnotherResponse: TResponse; 199 begin 200 if IsOutpatient then 201 begin 202 AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1); 203 if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then 204 begin 205 AResponse := SomeResponses.FindResponseByName('START', 1); 206 AnotherResponse := SomeResponses.FindResponseByName('MEAL', 1); 207 if (AResponse <> nil) and (AnotherResponse <> nil) then 208 CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1)); 209 end; 210 end 211 else 212 begin 213 AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1); 214 if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then 215 begin 216 AResponse := SomeResponses.FindResponseByName('START', 1); 217 if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False); 218 end; 219 end; 220 end; 221 222 procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean); 223 const 224 TX_EL_SAVE_ERR = 'An error occurred while saving this late tray order.'; 225 TC_EL_SAVE_ERR = 'Error Saving Late Tray Order'; 226 var 227 NewOrder: TOrder; 228 CanSign: integer; 229 begin 230 NewOrder := TOrder.Create; 231 try 232 with LateTrayFields do OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged); 233 if NewOrder.ID <> '' then 234 begin 235 if IsInpatient then 236 begin 237 if (Encounter.Provider = User.DUZ) and User.CanSignOrders 238 then CanSign := CH_SIGN_YES 239 else CanSign := CH_SIGN_NA; 240 end 241 else 242 begin 243 CanSign := CH_SIGN_NA; 244 end; 245 Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign); 246 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder)) 247 end 248 else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK); 249 finally 250 NewOrder.Free; 251 end; 252 end; 253 194 254 // ---------- frmODDietLT procedures --------------- 195 255 procedure TfrmODDietLT.FormCreate(Sender: TObject); -
cprs/trunk/CPRS-Chart/Orders/fODGen.dfm
r456 r829 1 1 inherited frmODGen: TfrmODGen 2 Left = 3143 Top = 4102 Left = 223 3 Top = 290 4 4 Caption = 'frmODGen' 5 ExplicitLeft = 223 6 ExplicitTop = 290 5 7 PixelsPerInch = 96 6 8 TextHeight = 13 … … 13 15 TabOrder = 4 14 16 end 15 inherited cmdAccept: TButton 16 Anchors = [akRight, akBottom] 17 inherited cmdQuit: TButton 18 Top = 219 19 ExplicitTop = 219 17 20 end 18 inherited cmdQuit: TButton 19 Anchors = [akRight, akBottom] 21 inherited amgrMain: TVA508AccessibilityManager 22 Data = ( 23 ( 24 'Component = sbxMain' 25 'Status = stsDefault') 26 ( 27 'Component = memOrder' 28 'Status = stsDefault') 29 ( 30 'Component = cmdAccept' 31 'Status = stsDefault') 32 ( 33 'Component = cmdQuit' 34 'Status = stsDefault') 35 ( 36 'Component = pnlMessage' 37 'Status = stsDefault') 38 ( 39 'Component = memMessage' 40 'Status = stsDefault') 41 ( 42 'Component = frmODGen' 43 'Status = stsDefault')) 20 44 end 21 45 end -
cprs/trunk/CPRS-Chart/Orders/fODGen.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fODBase, ComCtrls, ExtCtrls, StdCtrls, ORDtTm, ORCtrls, ORFn, rODBase; 7 fODBase, ComCtrls, ExtCtrls, StdCtrls, ORDtTm, ORCtrls, ORFn, rODBase, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type … … 23 24 procedure FormCreate(Sender: TObject); 24 25 procedure FormClose(Sender: TObject; var Action: TCloseAction); 26 procedure cmdAcceptClick(Sender: TObject); 25 27 private 26 28 FilterOut: boolean; … … 42 44 procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); 43 45 procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem); 46 procedure TrimAllMemos; 44 47 protected 48 FFormCloseCalled : Boolean; 45 49 FCharHt: Integer; 46 50 FCharWd: Integer; … … 54 58 procedure SetDialogIEN(Value: Integer); override; 55 59 procedure Validate(var AnErrMsg: string); override; 60 procedure UpdateAccessabilityActions(var Actions: TAccessibilityActions); override; 56 61 public 57 62 procedure SetupDialog(OrderAction: Integer; const ID: string); override; … … 79 84 IDs,TSstr, AttendStr: string; 80 85 begin 86 FFormCloseCalled := false; 81 87 inherited; 82 88 FilterOut := True; … … 129 135 FDialogItemList.Free; 130 136 FDialogCtrlList.Free; 137 FFormCloseCalled := true; 131 138 inherited; 132 139 end; … … 173 180 theEvtInfo := EventInfo1(AResponse.IValue); 174 181 AResponse.EValue := Piece(theEvtInfo,'^',4); 175 end; 182 end; 176 183 if AResponse = nil then 177 184 begin … … 199 206 Changing := False; 200 207 end; {if OrderAction} 208 UpdateColorsFor508Compliance(Self); 201 209 ControlChange(Self); 202 210 if (FFirstCtrl <> nil) and (FFirstCtrl.Enabled) then SetFocusedControl(FFirstCtrl); 211 end; 212 213 procedure TfrmODGen.UpdateAccessabilityActions( 214 var Actions: TAccessibilityActions); 215 begin 216 exclude(Actions, aaColorConversion); 203 217 end; 204 218 … … 492 506 with TORComboBox(Editor) do 493 507 begin 494 Items.AddStrings(TStrings(TopTSList));508 FastAddStrings(TStrings(TopTSList), TORComboBox(Editor).Items); 495 509 LongList := false; 496 510 end; … … 573 587 end; 574 588 589 procedure TfrmODGen.TrimAllMemos; 590 var 591 i : integer; 592 Memo : TMemo; 593 begin 594 if FFormCloseCalled then Exit; //it is possible for TrimAllMemos to get called after FormClose 595 if Not Assigned(FDialogCtrlList) then Exit; 596 for i := 0 to FDialogCtrlList.Count - 1 do 597 if TDialogCtrl(FDialogCtrlList.Items[i]).Editor is TMemo then begin 598 Memo := TMemo(TDialogCtrl(FDialogCtrlList.Items[i]).Editor); 599 Memo.Lines.Text := Trim(Memo.Lines.Text); 600 end; 601 end; 602 603 procedure TfrmODGen.cmdAcceptClick(Sender: TObject); 604 begin 605 inherited; 606 Application.ProcessMessages; 607 TrimAllMemos; 608 end; 609 575 610 procedure TfrmODGen.ControlChange(Sender: TObject); 576 611 var -
cprs/trunk/CPRS-Chart/Orders/fODLab.dfm
r456 r829 6 6 Height = 271 7 7 Caption = 'Order a Lab Test' 8 ExplicitWidth = 523 9 ExplicitHeight = 271 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 … … 295 297 Left = 443 296 298 TabOrder = 18 299 ExplicitLeft = 443 297 300 end 298 301 inherited cmdQuit: TButton … … 304 307 Height = 56 305 308 TabOrder = 21 309 ExplicitLeft = 18 310 ExplicitTop = 192 311 ExplicitHeight = 56 306 312 inherited imgMessage: TImage 307 313 Top = 11 314 ExplicitTop = 11 308 315 end 309 316 inherited memMessage: TRichEdit … … 312 319 Height = 43 313 320 PopupMenu = MessagePopup 314 end 315 end 316 object pnlCollTimeButton: TKeyClickPanel 321 ExplicitLeft = 41 322 ExplicitTop = 5 323 ExplicitHeight = 43 324 end 325 end 326 object pnlCollTimeButton: TKeyClickPanel [24] 317 327 Left = 288 318 328 Top = 167 … … 350 360 end 351 361 end 352 object cboAvailTest: TORComboBox 362 object cboAvailTest: TORComboBox [25] 353 363 Left = 6 354 364 Top = 18 … … 376 386 CharsNeedMatch = 1 377 387 end 378 object cboFrequency: TORComboBox 388 object cboFrequency: TORComboBox [26] 379 389 Left = 326 380 390 Top = 166 … … 400 410 CharsNeedMatch = 1 401 411 end 402 object cboCollSamp: TORComboBox 412 object cboCollSamp: TORComboBox [27] 403 413 Left = 269 404 414 Top = 28 … … 427 437 CharsNeedMatch = 1 428 438 end 429 object cboSpecimen: TORComboBox 439 object cboSpecimen: TORComboBox [28] 430 440 Left = 269 431 441 Top = 55 … … 456 466 CharsNeedMatch = 1 457 467 end 458 object cboUrgency: TORComboBox 468 object cboUrgency: TORComboBox [29] 459 469 Left = 269 460 470 Top = 82 … … 480 490 CharsNeedMatch = 1 481 491 end 482 object txtAddlComment: TCaptionEdit 492 object txtAddlComment: TCaptionEdit [30] 483 493 Left = 187 484 494 Top = 122 … … 490 500 Caption = 'Additional Comment' 491 501 end 492 object txtDays: TCaptionEdit 502 object txtDays: TCaptionEdit [31] 493 503 Left = 430 494 504 Top = 166 … … 501 511 Caption = 'How Long?' 502 512 end 503 object FLabCommonCombo: TORListBox 513 object FLabCommonCombo: TORListBox [32] 504 514 Left = 440 505 515 Top = 247 … … 515 525 LongList = False 516 526 end 517 object cboCollTime: TORComboBox 527 object cboCollTime: TORComboBox [33] 518 528 Left = 149 519 529 Top = 166 … … 540 550 CharsNeedMatch = 1 541 551 end 542 object cboCollType: TORComboBox 552 object cboCollType: TORComboBox [34] 543 553 Left = 6 544 554 Top = 166 … … 564 574 CharsNeedMatch = 1 565 575 end 576 inherited amgrMain: TVA508AccessibilityManager 577 Data = ( 578 ( 579 'Component = txtImmedColl' 580 'Status = stsDefault') 581 ( 582 'Component = calCollTime' 583 'Status = stsDefault') 584 ( 585 'Component = pnlUrineVolume' 586 'Status = stsDefault') 587 ( 588 'Component = txtUrineVolume' 589 'Status = stsDefault') 590 ( 591 'Component = pnlAntiCoagulation' 592 'Status = stsDefault') 593 ( 594 'Component = txtAntiCoagulant' 595 'Status = stsDefault') 596 ( 597 'Component = pnlOrderComment' 598 'Status = stsDefault') 599 ( 600 'Component = txtOrderComment' 601 'Status = stsDefault') 602 ( 603 'Component = pnlHide' 604 'Status = stsDefault') 605 ( 606 'Component = pnlDoseDraw' 607 'Status = stsDefault') 608 ( 609 'Component = txtDoseTime' 610 'Status = stsDefault') 611 ( 612 'Component = txtDrawTime' 613 'Status = stsDefault') 614 ( 615 'Component = pnlPeakTrough' 616 'Status = stsDefault') 617 ( 618 'Component = grpPeakTrough' 619 'Status = stsDefault') 620 ( 621 'Component = pnlCollTimeButton' 622 'Status = stsDefault') 623 ( 624 'Component = cboAvailTest' 625 'Status = stsDefault') 626 ( 627 'Component = cboFrequency' 628 'Status = stsDefault') 629 ( 630 'Component = cboCollSamp' 631 'Status = stsDefault') 632 ( 633 'Component = cboSpecimen' 634 'Status = stsDefault') 635 ( 636 'Component = cboUrgency' 637 'Status = stsDefault') 638 ( 639 'Component = txtAddlComment' 640 'Status = stsDefault') 641 ( 642 'Component = txtDays' 643 'Status = stsDefault') 644 ( 645 'Component = FLabCommonCombo' 646 'Status = stsDefault') 647 ( 648 'Component = cboCollTime' 649 'Status = stsDefault') 650 ( 651 'Component = cboCollType' 652 'Status = stsDefault') 653 ( 654 'Component = memOrder' 655 'Status = stsDefault') 656 ( 657 'Component = cmdAccept' 658 'Status = stsDefault') 659 ( 660 'Component = cmdQuit' 661 'Status = stsDefault') 662 ( 663 'Component = pnlMessage' 664 'Status = stsDefault') 665 ( 666 'Component = memMessage' 667 'Status = stsDefault') 668 ( 669 'Component = frmODLab' 670 'Status = stsDefault')) 671 end 566 672 object dlgLabCollTime: TORDateTimeDlg 567 FMDateTime = 2980923 673 FMDateTime = 2980923.000000000000000000 568 674 DateOnly = False 569 675 RequireTime = True -
cprs/trunk/CPRS-Chart/Orders/fODLab.pas
r456 r829 6 6 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 7 7 Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst, 8 ORDtTm, Buttons, Menus ;8 ORDtTm, Buttons, Menus, VA508AccessibilityManager; 9 9 10 10 type … … 106 106 FEvtDivision: integer; 107 107 procedure ReadServerVariables; 108 procedure DisplayChangedOrders(ACollType: string); 108 109 public 109 110 procedure SetupDialog(OrderAction: Integer; const ID: string); override; … … 240 241 EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0); 241 242 if EvtDelayLoc>0 then 242 AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))243 FastAssign(ODForLab(EvtDelayLoc, EvtDivision), AList) 243 244 else 244 AList.Assign(ODForLab(Encounter.Location,EvtDivision));245 FastAssign(ODForLab(Encounter.Location, EvtDivision), AList); 245 246 end else 246 AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults247 FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults 247 248 CtrlInits.LoadDefaults(AList); 248 249 InitDialog; … … 457 458 OneSamp := TStringList.Create; 458 459 try 459 OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));460 FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp); 460 461 FillCollSampList(OneSamp, CollSampList.Count); 461 462 finally … … 651 652 begin 652 653 if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ; 653 AComboBox.Items.Assign(SpecimenList);654 FastAssign(SpecimenList, AComboBox.Items); 654 655 AComboBox.Items.Add('0^Other...'); 655 656 with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1); … … 902 903 Days, MsgTxt: Double; 903 904 x: string; 905 ACollType: string; 904 906 const 905 907 TX_NO_TIME = 'Collection Time is required.' ; … … 1126 1128 end; 1127 1129 end; 1130 1131 if (AnErrMsg <> '') or (Self.EvtID > 0) then exit; 1132 1133 // add check and display for auto-change from LC to WC - v27.1 - CQ #10226 1134 ACollType := Responses.FindResponseByName('COLLECT', 1).EValue; 1135 if ((ACollType = 'LC') or (ACollType = 'I')) then DisplayChangedOrders(ACollType); 1136 end; 1137 1138 procedure TfrmODLab.DisplayChangedOrders(ACollType: string); 1139 var 1140 AStartDate, ASchedule, ADuration: string; 1141 ChangedOrdersList, AList: TStringlist; 1142 i, j, k: integer; 1143 begin 1144 ChangedOrdersList := TStringList.Create; 1145 try 1146 AStartDate := Responses.FindResponseByName('START', 1).IValue; 1147 ASchedule := Responses.FindResponseByName('SCHEDULE', 1).IValue; 1148 if txtDays.Enabled then ADuration := Responses.FindResponseByName('DAYS', 1).EValue else ADuration := ''; 1149 CheckForChangeFromLCtoWCOnAccept(ChangedOrdersList, Encounter.Location, AStartDate, ACollType, ASchedule, ADuration); 1150 if ChangedOrdersList.Text <> '' then 1151 begin 1152 AList := TStringList.Create; 1153 try 1154 AList.Text := Responses.OrderText; 1155 with ChangedOrdersList do 1156 begin 1157 Insert(5, 'Order :' + #9 + AList[0]); 1158 k := Length(ChangedOrdersList[5]); 1159 i := 0; 1160 if AList.Count > 1 then 1161 for j := 1 to AList.Count - 1 do 1162 begin 1163 Insert(5 + j, StringOfChar(' ', 9) + #9 + AList[j]); 1164 k := HigherOf(k, Length(ChangedOrdersList[5 + j])); 1165 i := j; 1166 end; 1167 Insert(5 + i + 1, StringOfChar('-', k + 4)); 1168 end; 1169 ReportBox(ChangedOrdersList, 'Changed Orders', TRUE); 1170 finally 1171 AList.Free; 1172 end; 1173 end; 1174 finally 1175 ChangedOrdersList.Free; 1176 end; 1128 1177 end; 1129 1178 -
cprs/trunk/CPRS-Chart/Orders/fODLabImmedColl.dfm
r456 r829 1 objectfrmODLabImmedColl: TfrmODLabImmedColl1 inherited frmODLabImmedColl: TfrmODLabImmedColl 2 2 Left = 146 3 3 Top = 150 4 Width = 5245 Height = 2866 4 Caption = 'Immediate Collection Times' 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 = [] 5 ClientHeight = 259 6 ClientWidth = 516 13 7 OldCreateOrder = True 14 8 OnShow = FormShow 15 9 PixelsPerInch = 96 16 10 TextHeight = 13 17 object pnlBase: TORAutoPanel 11 object pnlBase: TORAutoPanel [0] 18 12 Left = 0 19 13 Top = 0 … … 85 79 end 86 80 end 81 inherited amgrMain: TVA508AccessibilityManager 82 Data = ( 83 ( 84 'Component = pnlBase' 85 'Status = stsDefault') 86 ( 87 'Component = memImmedCollect' 88 'Status = stsDefault') 89 ( 90 'Component = calImmedCollect' 91 'Status = stsDefault') 92 ( 93 'Component = cmdOK' 94 'Status = stsDefault') 95 ( 96 'Component = cmdCancel' 97 'Status = stsDefault') 98 ( 99 'Component = frmODLabImmedColl' 100 'Status = stsDefault')) 101 end 87 102 end -
cprs/trunk/CPRS-Chart/Orders/fODLabImmedColl.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn; 7 StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmODLabImmedColl = class(T Form)11 TfrmODLabImmedColl = class(TfrmBase508Form) 11 12 memImmedCollect: TCaptionMemo; 12 13 calImmedCollect: TORDateBox; … … 93 94 procedure TfrmODLabImmedColl.FormShow(Sender: TObject); 94 95 begin 95 memImmedCollect.Lines.Assign(ImmediateCollectTimes);96 FastAssign(ImmediateCollectTimes, memImmedCollect.Lines); 96 97 if Length(FCollTime) > 0 then 97 98 calImmedCollect.Text := FCollTime -
cprs/trunk/CPRS-Chart/Orders/fODLabOthCollSamp.dfm
r456 r829 1 objectfrmODLabOthCollSamp: TfrmODLabOthCollSamp1 inherited frmODLabOthCollSamp: TfrmODLabOthCollSamp 2 2 Left = 321 3 3 Top = 136 4 Width = 2365 Height = 3596 4 BorderIcons = [] 7 5 Caption = 'Select Collection Sample' 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 = 332 7 ClientWidth = 228 14 8 OldCreateOrder = True 15 9 Position = poScreenCenter 10 ExplicitWidth = 236 11 ExplicitHeight = 359 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 … … 38 34 ListItemsOnly = True 39 35 LongList = False 36 LookupPiece = 0 40 37 MaxLength = 0 41 38 Pieces = '2' … … 44 41 TabOrder = 0 45 42 OnDblClick = cboOtherCollSampDblClick 43 CharsNeedMatch = 1 46 44 end 47 45 object cmdOK: TButton … … 66 64 end 67 65 end 66 inherited amgrMain: TVA508AccessibilityManager 67 Data = ( 68 ( 69 'Component = pnlBase' 70 'Status = stsDefault') 71 ( 72 'Component = cboOtherCollSamp' 73 'Status = stsDefault') 74 ( 75 'Component = cmdOK' 76 'Status = stsDefault') 77 ( 78 'Component = cmdCancel' 79 'Status = stsDefault') 80 ( 81 'Component = frmODLabOthCollSamp' 82 'Status = stsDefault')) 83 end 68 84 end -
cprs/trunk/CPRS-Chart/Orders/fODLabOthCollSamp.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ExtCtrls, ORCtrls, StdCtrls, ORFn ;7 ExtCtrls, ORCtrls, StdCtrls, ORFn, fBase508Form, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmODLabOthCollSamp = class(T Form)10 TfrmODLabOthCollSamp = class(TfrmBase508Form) 11 11 pnlBase: TORAutoPanel; 12 12 cboOtherCollSamp: TORComboBox; -
cprs/trunk/CPRS-Chart/Orders/fODLabOthSpec.dfm
r456 r829 1 objectfrmODLabOthSpec: TfrmODLabOthSpec1 inherited frmODLabOthSpec: TfrmODLabOthSpec 2 2 Left = 240 3 3 Top = 136 4 Width = 3175 Height = 3596 4 BorderIcons = [] 7 5 Caption = 'Select Specimen' 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 = 332 7 ClientWidth = 309 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 … … 38 32 ListItemsOnly = True 39 33 LongList = True 34 LookupPiece = 0 40 35 MaxLength = 0 41 36 Pieces = '2' … … 45 40 OnDblClick = cboOtherSpecDblClick 46 41 OnNeedData = cboOtherSpecNeedData 42 CharsNeedMatch = 1 47 43 end 48 44 object cmdOK: TButton … … 67 63 end 68 64 end 65 inherited amgrMain: TVA508AccessibilityManager 66 Data = ( 67 ( 68 'Component = pnlBase' 69 'Status = stsDefault') 70 ( 71 'Component = cboOtherSpec' 72 'Status = stsDefault') 73 ( 74 'Component = cmdOK' 75 'Status = stsDefault') 76 ( 77 'Component = cmdCancel' 78 'Status = stsDefault') 79 ( 80 'Component = frmODLabOthSpec' 81 'Status = stsDefault')) 82 end 69 83 end -
cprs/trunk/CPRS-Chart/Orders/fODLabOthSpec.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ExtCtrls, ORCtrls, StdCtrls, ORFn ;7 ExtCtrls, ORCtrls, StdCtrls, ORFn, fBase508Form, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmODLabOthSpec = class(T Form)10 TfrmODLabOthSpec = class(TfrmBase508Form) 11 11 pnlBase: TORAutoPanel; 12 12 cboOtherSpec: TORComboBox; … … 52 52 with cboOtherSpec do 53 53 begin 54 { MItems.Assign(SpecimenList);54 {FastAssign(SpecimenList, MItems); 55 55 InsertSeparator; } 56 56 InitLongList(''); -
cprs/trunk/CPRS-Chart/Orders/fODMedComplex.dfm
r456 r829 2 2 Left = 291 3 3 Top = 307 4 Width = 4535 Height = 2546 4 BorderIcons = [] 7 5 Caption = 'Complex Dose' 6 ClientHeight = 227 7 ClientWidth = 445 8 8 Position = poScreenCenter 9 9 OnCreate = FormCreate 10 ExplicitWidth = 453 11 ExplicitHeight = 254 10 12 PixelsPerInch = 96 11 13 TextHeight = 13 12 object Bevel1: TBevel 14 object Bevel1: TBevel [0] 13 15 Left = 6 14 16 Top = 174 … … 16 18 Height = 2 17 19 end 18 object grdDoses: TStringGrid 20 object grdDoses: TStringGrid [1] 19 21 Left = 6 20 22 Top = 6 … … 39 41 21) 40 42 end 41 object cmdOK: TButton 43 object cmdOK: TButton [2] 42 44 Left = 290 43 45 Top = 184 … … 48 50 OnClick = cmdOKClick 49 51 end 50 object cmdCancel: TButton 52 object cmdCancel: TButton [3] 51 53 Left = 368 52 54 Top = 184 … … 57 59 OnClick = cmdCancelClick 58 60 end 59 object cboRoute: TORComboBox 61 object cboRoute: TORComboBox [4] 60 62 Left = 170 61 63 Top = 200 … … 71 73 ListItemsOnly = False 72 74 LongList = False 75 LookupPiece = 0 73 76 MaxLength = 0 74 77 Pieces = '2' … … 79 82 OnClick = cboRouteClick 80 83 OnExit = cboRouteExit 81 end 82 object cboSchedule: TORComboBox 84 CharsNeedMatch = 1 85 end 86 object cboSchedule: TORComboBox [5] 83 87 Left = 169 84 88 Top = 176 … … 94 98 ListItemsOnly = False 95 99 LongList = False 100 LookupPiece = 0 96 101 MaxLength = 0 97 102 Sorted = False … … 100 105 Visible = False 101 106 OnExit = cboScheduleExit 102 end 103 object pnlInstruct: TPanel 107 CharsNeedMatch = 1 108 end 109 object pnlInstruct: TPanel [6] 104 110 Left = 6 105 111 Top = 177 … … 144 150 ListItemsOnly = False 145 151 LongList = False 152 LookupPiece = 0 146 153 MaxLength = 80 147 154 Sorted = False 148 155 SynonymChars = '<>' 149 156 TabOrder = 0 150 end 151 end 152 object pnlDays: TPanel 157 CharsNeedMatch = 1 158 end 159 end 160 object pnlDays: TPanel [7] 153 161 Left = 6 154 162 Top = 201 … … 184 192 Height = 21 185 193 Associate = txtDays 186 Min = 0187 194 Max = 999 188 Position = 0189 195 TabOrder = 1 190 Wrap = False 191 end 192 end 193 object cmdInsert: TButton 196 end 197 end 198 object cmdInsert: TButton [8] 194 199 Left = 6 195 200 Top = 149 … … 200 205 OnClick = cmdInsertClick 201 206 end 202 object cmdRemove: TButton 207 object cmdRemove: TButton [9] 203 208 Left = 92 204 209 Top = 149 … … 209 214 OnClick = cmdRemoveClick 210 215 end 216 inherited amgrMain: TVA508AccessibilityManager 217 Data = ( 218 ( 219 'Component = grdDoses' 220 'Status = stsDefault') 221 ( 222 'Component = cmdOK' 223 'Status = stsDefault') 224 ( 225 'Component = cmdCancel' 226 'Status = stsDefault') 227 ( 228 'Component = cboRoute' 229 'Status = stsDefault') 230 ( 231 'Component = cboSchedule' 232 'Status = stsDefault') 233 ( 234 'Component = pnlInstruct' 235 'Status = stsDefault') 236 ( 237 'Component = cboInstruct' 238 'Status = stsDefault') 239 ( 240 'Component = pnlDays' 241 'Status = stsDefault') 242 ( 243 'Component = txtDays' 244 'Status = stsDefault') 245 ( 246 'Component = UpDown2' 247 'Status = stsDefault') 248 ( 249 'Component = cmdInsert' 250 'Status = stsDefault') 251 ( 252 'Component = cmdRemove' 253 'Status = stsDefault') 254 ( 255 'Component = frmODMedComplex' 256 'Status = stsDefault')) 257 end 211 258 object popUnits: TPopupMenu 212 259 AutoPopup = False -
cprs/trunk/CPRS-Chart/Orders/fODMedComplex.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fAutoSz, StdCtrls, Grids, Buttons, ExtCtrls, ORCtrls, Menus, ORFn, fODBase, uConst, 8 ComCtrls ;8 ComCtrls, VA508AccessibilityManager; 9 9 10 10 type -
cprs/trunk/CPRS-Chart/Orders/fODMedFA.dfm
r456 r829 2 2 Left = 333 3 3 Top = 258 4 Width = 3165 Height = 2056 4 Caption = 'Formulary Alternatives' 5 ClientHeight = 178 6 ClientWidth = 308 7 7 FormStyle = fsStayOnTop 8 8 OnCreate = FormCreate 9 ExplicitWidth = 316 10 ExplicitHeight = 205 9 11 PixelsPerInch = 96 10 12 TextHeight = 13 11 object Label1: TLabel 13 object Label1: TLabel [0] 12 14 Left = 8 13 15 Top = 8 … … 16 18 Caption = 'The selected drug is not in the formulary. Alternatives are:' 17 19 end 18 object Label2: TStaticText 20 object Label2: TStaticText [1] 19 21 Left = 8 20 22 Top = 127 … … 24 26 TabOrder = 3 25 27 end 26 object lstFormAlt: TORListBox 28 object lstFormAlt: TORListBox [2] 27 29 Left = 8 28 30 Top = 22 … … 39 41 Pieces = '2' 40 42 end 41 object cmdYes: TButton 43 object cmdYes: TButton [3] 42 44 Left = 74 43 45 Top = 148 … … 50 52 OnClick = cmdYesClick 51 53 end 52 object cmdNo: TButton 54 object cmdNo: TButton [4] 53 55 Left = 162 54 56 Top = 148 … … 60 62 OnClick = cmdNoClick 61 63 end 64 inherited amgrMain: TVA508AccessibilityManager 65 Data = ( 66 ( 67 'Component = Label2' 68 'Status = stsDefault') 69 ( 70 'Component = lstFormAlt' 71 'Status = stsDefault') 72 ( 73 'Component = cmdYes' 74 'Status = stsDefault') 75 ( 76 'Component = cmdNo' 77 'Status = stsDefault') 78 ( 79 'Component = frmODMedFA' 80 'Status = stsDefault')) 81 end 62 82 end -
cprs/trunk/CPRS-Chart/Orders/fODMedFA.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORCtrls, ORFn ;7 fAutoSz, StdCtrls, ORCtrls, ORFn, VA508AccessibilityManager; 8 8 9 9 type … … 60 60 with frmODMedFA do 61 61 begin 62 lstFormAlt.Items.Assign(FormAltList);62 FastAssign(FormAltList, lstFormAlt.Items); 63 63 ShowModal; 64 64 if Length(FSelected) > 0 then -
cprs/trunk/CPRS-Chart/Orders/fODMedIV.dfm
r456 r829 1 1 inherited frmODMedIV: TfrmODMedIV 2 Left = 5873 Top = 3314 Width = 6 105 Height = 3412 Left = 246 3 Top = 256 4 Width = 668 5 Height = 465 6 6 Caption = 'Infusion Order' 7 OnKeyDown = FormKeyDown 7 Constraints.MinHeight = 350 8 Constraints.MinWidth = 500 9 ExplicitWidth = 668 10 ExplicitHeight = 465 8 11 PixelsPerInch = 96 9 12 TextHeight = 13 10 13 object lblInfusionRate: TLabel [0] 11 Left = 612 Top = 19 613 Width = 9614 Height = 13 15 Caption = 'Infusion Rate (ml/hr) '14 Left = 486 15 Top = 197 16 Width = 100 17 Height = 13 18 Caption = 'Infusion Rate (ml/hr)*' 16 19 end 17 20 object lblPriority: TLabel [1] 18 Left = 13419 Top = 19620 Width = 3 121 Height = 13 22 Caption = 'Priority '21 Left = 8 22 Top = 238 23 Width = 35 24 Height = 13 25 Caption = 'Priority*' 23 26 end 24 27 object lblComponent: TLabel [2] 25 28 Left = 214 26 Top = 627 Width = 8 128 Height = 13 29 Caption = 'Solution/Additive '29 Top = 7 30 Width = 85 31 Height = 13 32 Caption = 'Solution/Additive*' 30 33 end 31 34 object lblAmount: TLabel [3] 32 35 Left = 328 33 Top = 634 Width = 8 035 Height = 13 36 Caption = 'Volume/Strength '36 Top = 7 37 Width = 84 38 Height = 13 39 Caption = 'Volume/Strength*' 37 40 WordWrap = True 38 41 end 39 42 object lblComments: TLabel [4] 40 43 Left = 214 41 Top = 10 644 Top = 107 42 45 Width = 49 43 46 Height = 13 … … 45 48 end 46 49 object lblLimit: TLabel [5] 47 Left = 230 48 Top = 196 49 Width = 117 50 Height = 13 51 Caption = 'Duration or Total Volume' 52 end 53 object txtRate: TCaptionEdit [6] 54 Left = 6 55 Top = 210 50 Left = 185 51 Top = 238 52 Width = 165 53 Height = 13 54 Caption = 'Duration or Total Volume (Optional)' 55 end 56 object Label1: TLabel [6] 57 Left = 8 58 Top = 344 59 Width = 133 60 Height = 13 61 Caption = ' * Indicates a Required Field' 62 end 63 object lblRoute: TLabel [7] 64 Left = 8 65 Top = 197 66 Width = 33 67 Height = 13 68 Caption = 'Route*' 69 end 70 object lblSchedule: TLabel [8] 71 Left = 304 72 Top = 197 73 Width = 52 74 Height = 13 75 Caption = 'Schedule *' 76 end 77 object lblType: TLabel [9] 78 Left = 184 79 Top = 197 80 Width = 28 81 Height = 13 82 Caption = 'Type*' 83 ParentShowHint = False 84 ShowHint = True 85 end 86 object txtNSS: TLabel [10] 87 Left = 361 88 Top = 197 89 Width = 69 90 Height = 13 91 Caption = '(Day-of-Week)' 92 Color = clBtnFace 93 Font.Charset = DEFAULT_CHARSET 94 Font.Color = clBlue 95 Font.Height = -11 96 Font.Name = 'MS Sans Serif' 97 Font.Style = [] 98 ParentColor = False 99 ParentFont = False 100 OnClick = txtNSSClick 101 end 102 object txtAllIVRoutes: TLabel [11] 103 Left = 47 104 Top = 197 105 Width = 129 106 Height = 13 107 Caption = '(Expanded Med Route List)' 108 Font.Charset = DEFAULT_CHARSET 109 Font.Color = clBlue 110 Font.Height = -11 111 Font.Name = 'MS Sans Serif' 112 Font.Style = [] 113 ParentFont = False 114 Visible = False 115 OnClick = txtAllIVRoutesClick 116 end 117 object lblTypeHelp: TLabel [12] 118 Left = 219 119 Top = 197 120 Width = 68 121 Height = 13 122 Caption = '(IV Type Help)' 123 Font.Charset = DEFAULT_CHARSET 124 Font.Color = clBlue 125 Font.Height = -11 126 Font.Name = 'MS Sans Serif' 127 Font.Style = [] 128 ParentFont = False 129 ParentShowHint = False 130 ShowHint = False 131 OnClick = lblTypeHelpClick 132 end 133 object txtRate: TCaptionEdit [13] 134 Left = 486 135 Top = 211 56 136 Width = 91 57 137 Height = 21 58 138 AutoSelect = False 59 TabOrder = 5 60 OnChange = ControlChange 61 OnExit = txtRateExit 139 TabOrder = 8 140 OnChange = txtRateChange 62 141 Caption = 'Infusion Rate' 63 142 end 64 object cboPriority: TORComboBox [ 7]65 Left = 13466 Top = 2 10143 object cboPriority: TORComboBox [14] 144 Left = 8 145 Top = 252 67 146 Width = 72 68 147 Height = 21 … … 82 161 Sorted = False 83 162 SynonymChars = '<>' 84 TabOrder = 6 85 OnChange = ControlChange 163 TabOrder = 10 164 OnChange = cboPriorityChange 165 OnExit = cboPriorityExit 86 166 CharsNeedMatch = 1 87 167 end 88 object grdSelected: TCaptionStringGrid [ 8]168 object grdSelected: TCaptionStringGrid [15] 89 169 Left = 214 90 Top = 2 091 Width = 384170 Top = 21 171 Width = 437 92 172 Height = 76 93 173 ColCount = 3 … … 99 179 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected] 100 180 ScrollBars = ssVertical 101 TabOrder = 2181 TabOrder = 1 102 182 OnDrawCell = grdSelectedDrawCell 103 183 OnKeyPress = grdSelectedKeyPress … … 105 185 Caption = 'Selected Solution and Additives' 106 186 end 107 object cmdRemove: TButton [ 9]187 object cmdRemove: TButton [16] 108 188 Left = 443 109 Top = 99189 Top = 100 110 190 Width = 72 111 191 Height = 18 112 192 Caption = 'Remove' 113 TabOrder = 3193 TabOrder = 2 114 194 OnClick = cmdRemoveClick 115 195 end 116 object memComments: TCaptionMemo [1 0]196 object memComments: TCaptionMemo [17] 117 197 Left = 214 118 Top = 12 0119 Width = 384198 Top = 121 199 Width = 437 120 200 Height = 66 121 201 Lines.Strings = ( 122 202 'memComments') 123 203 ScrollBars = ssVertical 124 TabOrder = 4204 TabOrder = 13 125 205 OnChange = ControlChange 126 206 Caption = 'Comments' 127 207 end 128 object txtSelected: TCaptionEdit [1 1]208 object txtSelected: TCaptionEdit [18] 129 209 Tag = -1 130 210 Left = 416 131 Top = 4 4211 Top = 45 132 212 Width = 45 133 213 Height = 19 … … 141 221 Caption = 'Volume' 142 222 end 143 object cboSelected: TCaptionComboBox [1 2]223 object cboSelected: TCaptionComboBox [19] 144 224 Tag = -1 145 225 Left = 460 146 Top = 4 4226 Top = 45 147 227 Width = 53 148 228 Height = 21 … … 151 231 ItemHeight = 13 152 232 ParentCtl3D = False 153 TabOrder = 1233 TabOrder = 4 154 234 Visible = False 155 235 OnChange = cboSelectedChange … … 158 238 end 159 239 inherited memOrder: TCaptionMemo 160 Top = 255240 Top = 359 161 241 Width = 475 162 TabOrder = 10 163 end 164 inherited cmdAccept: TButton 165 Left = 495 166 Top = 255 167 TabOrder = 8 168 end 169 inherited cmdQuit: TButton 170 Left = 495 171 Top = 282 172 TabOrder = 9 173 end 174 inherited pnlMessage: TPanel 175 Top = 237 242 TabStop = True 243 TabOrder = 16 244 ExplicitTop = 359 245 ExplicitWidth = 475 246 end 247 object pnlXDuration: TPanel [21] 248 Left = 184 249 Top = 252 250 Width = 150 251 Height = 21 252 BevelOuter = bvNone 176 253 TabOrder = 11 177 end178 object pnlXDuration: TPanel179 Left = 229180 Top = 210181 Width = 121182 Height = 21183 BevelOuter = bvNone184 TabOrder = 7185 254 OnEnter = pnlXDurationEnter 186 DesignSize = (187 121188 21)189 object btnXDuration: TBitBtn190 Left = 69191 Top = 1192 Width = 50193 Height = 20194 Anchors = [akLeft, akTop, akRight, akBottom]195 Caption = 'days'196 TabOrder = 1197 OnClick = btnXDurationClick198 Glyph.Data = {199 AE000000424DAE0000000000000076000000280000000E000000070000000100200 0400000000003800000000000000000000001000000000000000000000000000201 8000008000000080800080000000800080008080000080808000C0C0C0000000202 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333203 330033333333333333003330333333733300330003333F87330030000033FFFF204 F30033333333333333003333333333333300}205 Layout = blGlyphRight206 NumGlyphs = 2207 Spacing = 0208 end209 255 object txtXDuration: TCaptionEdit 210 256 Left = 0 … … 217 263 Caption = 'Duration' 218 264 end 219 end 220 object pnlCombo: TPanel 221 Left = 8 222 Top = 1 265 object cboDuration: TComboBox 266 Left = 70 267 Top = 0 268 Width = 75 269 Height = 21 270 ItemHeight = 13 271 TabOrder = 2 272 OnChange = cboDurationChange 273 OnEnter = cboDurationEnter 274 end 275 end 276 object pnlCombo: TPanel [22] 277 Left = 8 278 Top = 2 223 279 Width = 200 224 280 Height = 185 225 281 BevelOuter = bvNone 226 TabOrder = 17282 TabOrder = 25 227 283 object cboAdditive: TORComboBox 228 284 Left = 0 … … 260 316 Align = alTop 261 317 TabHeight = 15 262 TabOrder = 1318 TabOrder = 2 263 319 Tabs.Strings = ( 264 320 ' Solutions ' … … 290 346 SynonymChars = '<>' 291 347 TabPositions = '20' 292 TabOrder = 2348 TabOrder = 1 293 349 OnExit = cboSolutionExit 294 350 OnMouseClick = cboSolutionMouseClick … … 297 353 end 298 354 end 299 object popDuration: TPopupMenu 300 AutoHotkeys = maManual 301 Left = 387 302 Top = 91 303 object popL: TMenuItem 304 Tag = 1 305 Caption = 'L' 306 OnClick = popDurationClick 307 end 308 object popML: TMenuItem 309 Tag = 2 310 Caption = 'ml' 311 OnClick = popDurationClick 312 end 313 object popDays: TMenuItem 314 Tag = 3 315 Caption = 'days' 316 OnClick = popDurationClick 317 end 318 object popHours: TMenuItem 319 Tag = 4 320 Caption = 'hours' 321 OnClick = popDurationClick 322 end 355 object cboRoute: TORComboBox [23] 356 Left = 8 357 Top = 211 358 Width = 168 359 Height = 21 360 Style = orcsDropDown 361 AutoSelect = True 362 Color = clWindow 363 DropDownCount = 8 364 ItemHeight = 13 365 ItemTipColor = clWindow 366 ItemTipEnable = True 367 ListItemsOnly = False 368 LongList = False 369 LookupPiece = 0 370 MaxLength = 0 371 Pieces = '2' 372 Sorted = False 373 SynonymChars = '<>' 374 TabOrder = 3 375 OnChange = cboRouteChange 376 OnClick = cboRouteClick 377 OnExit = cboRouteExit 378 CharsNeedMatch = 1 379 UniqueAutoComplete = True 380 end 381 object cboSchedule: TORComboBox [24] 382 Left = 304 383 Top = 211 384 Width = 129 385 Height = 21 386 Style = orcsDropDown 387 AutoSelect = True 388 Color = clWindow 389 DropDownCount = 8 390 ItemHeight = 13 391 ItemTipColor = clWindow 392 ItemTipEnable = True 393 ListItemsOnly = False 394 LongList = False 395 LookupPiece = 1 396 MaxLength = 0 397 Pieces = '1' 398 Sorted = True 399 SynonymChars = '<>' 400 TabOrder = 6 401 OnChange = cboScheduleChange 402 OnClick = cboScheduleClick 403 OnExit = cboScheduleExit 404 CharsNeedMatch = 1 405 UniqueAutoComplete = True 406 end 407 object cboType: TComboBox [25] 408 Left = 184 409 Top = 211 410 Width = 114 411 Height = 21 412 ItemHeight = 13 413 ParentShowHint = False 414 ShowHint = True 415 TabOrder = 5 416 OnChange = cboTypeChange 417 end 418 object chkPRN: TCheckBox [26] 419 Left = 436 420 Top = 213 421 Width = 45 422 Height = 21 423 Caption = 'PRN' 424 TabOrder = 7 425 OnClick = chkPRNClick 426 end 427 object chkDoseNow: TCheckBox [27] 428 Left = 8 429 Top = 279 430 Width = 147 431 Height = 17 432 Anchors = [akLeft] 433 Caption = 'Give Additional Dose Now' 434 Constraints.MinWidth = 147 435 TabOrder = 12 436 OnClick = chkDoseNowClick 437 end 438 object cboInfusionTime: TComboBox [28] 439 Left = 576 440 Top = 211 441 Width = 74 442 Height = 21 443 ItemHeight = 13 444 TabOrder = 9 445 OnChange = cboInfusionTimeChange 446 OnEnter = cboInfusionTimeEnter 447 end 448 object lblAdminTime: TVA508StaticText [29] 449 Name = 'lblAdminTime' 450 Left = 8 451 Top = 308 452 Width = 4 453 Height = 4 454 Alignment = taLeftJustify 455 ParentShowHint = False 456 ShowHint = True 457 TabOrder = 14 458 TabStop = True 459 Visible = False 460 ShowAccelChar = True 461 end 462 object lblFirstDose: TVA508StaticText [30] 463 Name = 'lblFirstDose' 464 Left = 8 465 Top = 323 466 Width = 4 467 Height = 4 468 Alignment = taLeftJustify 469 TabOrder = 15 470 TabStop = True 471 Visible = False 472 ShowAccelChar = True 473 end 474 inherited cmdAccept: TButton 475 Left = 495 476 Top = 359 477 TabOrder = 17 478 ExplicitLeft = 495 479 ExplicitTop = 359 480 end 481 inherited cmdQuit: TButton 482 Left = 495 483 Top = 386 484 TabOrder = 18 485 ExplicitLeft = 495 486 ExplicitTop = 386 487 end 488 inherited pnlMessage: TPanel 489 Left = 56 490 Top = 349 491 TabOrder = 19 492 ExplicitLeft = 56 493 ExplicitTop = 349 494 end 495 inherited amgrMain: TVA508AccessibilityManager 496 Data = ( 497 ( 498 'Component = txtRate' 499 'Status = stsDefault') 500 ( 501 'Component = cboPriority' 502 'Status = stsDefault') 503 ( 504 'Component = grdSelected' 505 'Status = stsDefault') 506 ( 507 'Component = cmdRemove' 508 'Status = stsDefault') 509 ( 510 'Component = memComments' 511 'Status = stsDefault') 512 ( 513 'Component = txtSelected' 514 'Status = stsDefault') 515 ( 516 'Component = cboSelected' 517 'Status = stsDefault') 518 ( 519 'Component = pnlXDuration' 520 'Status = stsDefault') 521 ( 522 'Component = txtXDuration' 523 'Status = stsDefault') 524 ( 525 'Component = pnlCombo' 526 'Status = stsDefault') 527 ( 528 'Component = cboAdditive' 529 'Status = stsDefault') 530 ( 531 'Component = tabFluid' 532 'Status = stsDefault') 533 ( 534 'Component = cboSolution' 535 'Status = stsDefault') 536 ( 537 'Component = cboRoute' 538 'Status = stsDefault') 539 ( 540 'Component = cboSchedule' 541 'Status = stsDefault') 542 ( 543 'Component = cboType' 544 'Status = stsDefault') 545 ( 546 'Component = chkPRN' 547 'Status = stsDefault') 548 ( 549 'Component = chkDoseNow' 550 'Status = stsDefault') 551 ( 552 'Component = memOrder' 553 'Status = stsDefault') 554 ( 555 'Component = cmdAccept' 556 'Status = stsDefault') 557 ( 558 'Component = cmdQuit' 559 'Status = stsDefault') 560 ( 561 'Component = pnlMessage' 562 'Status = stsDefault') 563 ( 564 'Component = memMessage' 565 'Status = stsDefault') 566 ( 567 'Component = frmODMedIV' 568 'Status = stsDefault') 569 ( 570 'Component = cboInfusionTime' 571 'Status = stsDefault') 572 ( 573 'Component = cboDuration' 574 'Status = stsDefault') 575 ( 576 'Component = lblAdminTime' 577 'Status = stsDefault') 578 ( 579 'Component = lblFirstDose' 580 'Status = stsDefault')) 323 581 end 324 582 end -
cprs/trunk/CPRS-Chart/Orders/fODMedIV.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fODBase, Grids, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, Buttons, Menus, IdGlobal; 7 fODBase, Grids, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, Buttons, Menus, IdGlobal, strUtils, 8 VA508AccessibilityManager, VAUtils, fIVRoutes; 8 9 9 10 type … … 19 20 txtSelected: TCaptionEdit; 20 21 cboSelected: TCaptionComboBox; 21 popDuration: TPopupMenu;22 popML: TMenuItem;23 popDays: TMenuItem;24 popHours: TMenuItem;25 popL: TMenuItem;26 22 pnlXDuration: TPanel; 27 23 txtXDuration: TCaptionEdit; 28 24 lblLimit: TLabel; 29 btnXDuration: TBitBtn;30 25 pnlCombo: TPanel; 31 26 cboAdditive: TORComboBox; … … 34 29 lblPriority: TLabel; 35 30 cboPriority: TORComboBox; 31 Label1: TLabel; 32 cboRoute: TORComboBox; 33 cboSchedule: TORComboBox; 34 lblRoute: TLabel; 35 lblSchedule: TLabel; 36 cboType: TComboBox; 37 lblType: TLabel; 38 chkPRN: TCheckBox; 39 txtNSS: TLabel; 40 chkDoseNow: TCheckBox; 41 cboInfusionTime: TComboBox; 42 cboDuration: TComboBox; 43 lblAdminTime: TVA508StaticText; 44 lblFirstDose: TVA508StaticText; 45 txtAllIVRoutes: TLabel; 46 lblTypeHelp: TLabel; 36 47 procedure FormCreate(Sender: TObject); 37 48 procedure tabFluidChange(Sender: TObject); 38 procedure cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction,49 procedure cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction, 39 50 InsertAt: Integer); 40 51 procedure cboSolutionNeedData(Sender: TObject; const StartFrom: string; Direction, … … 59 70 procedure grdSelectedMouseDown(Sender: TObject; Button: TMouseButton; 60 71 Shift: TShiftState; X, Y: Integer); 61 procedure btnXDurationClick(Sender: TObject);62 procedure popDurationClick(Sender: TObject);63 72 procedure txtXDurationChange(Sender: TObject); 64 73 procedure pnlXDurationEnter(Sender: TObject); 65 74 procedure txtXDurationExit(Sender: TObject); 66 procedure txtRateExit(Sender: TObject); 75 procedure cboScheduleChange(Sender: TObject); 76 procedure cboTypeChange(Sender: TObject); 77 procedure cboRouteChange(Sender: TObject); 78 procedure txtRateChange(Sender: TObject); 79 procedure cboPriorityChange(Sender: TObject); 80 procedure cboPriorityExit(Sender: TObject); 81 procedure cboRouteExit(Sender: TObject); 82 procedure txtNSSClick(Sender: TObject); 83 procedure cboScheduleClick(Sender: TObject); 84 procedure chkPRNClick(Sender: TObject); 85 procedure chkDoseNowClick(Sender: TObject); 86 procedure loadExpectFirstDose; 87 procedure SetSchedule(const x: string); 88 procedure cboScheduleExit(Sender: TObject); 89 procedure cboInfusionTimeChange(Sender: TObject); 90 procedure cboDurationChange(Sender: TObject); 91 procedure cboDurationEnter(Sender: TObject); 92 procedure cboInfusionTimeEnter(Sender: TObject); 93 procedure txtAllIVRoutesClick(Sender: TObject); 94 procedure cboRouteClick(Sender: TObject); 95 procedure lblTypeHelpClick(Sender: TObject); 67 96 private 68 97 FInpatient: Boolean; 98 FNSSAdminTime: string; 99 FNSSScheduleType: string; 100 OSolIEN: integer; 101 OAddIEN: integer; 102 OSchedule: string; 103 oAdmin: string; 104 Action: integer; 105 OrderIEN: string; 106 FAdminTimeText: string; 107 JAWSON: boolean; 108 FOriginalDurationType: integer; 109 FOriginalInfusionType: integer; 110 FInitialOrderID: boolean; 69 111 procedure SetValuesFromResponses; 70 112 procedure DoSetFontSize( FontSize: integer); 71 113 procedure ClickOnGridCell; 72 114 procedure SetLimitationControl(aValue: string); 115 function CreateOtherSchedule: string; 116 function CreateOtherRoute: string; 117 procedure UpdateRoute; 118 procedure DisplayDoseNow(Status: boolean); 119 procedure UpdateDuration(SchType: string); 120 procedure ClearAllFields; 73 121 public 74 122 procedure InitDialog; override; … … 76 124 procedure Validate(var AnErrMsg: string); override; 77 125 procedure SetFontSize( FontSize: integer); override; 126 function ValidateInfusionRate(Rate: string): string; 127 function IVTypeHelpText: string; 128 property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime; 129 property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType; 78 130 end; 79 131 … … 85 137 {$R *.DFM} 86 138 87 uses ORFn, uConst, rODMeds, rODBase, uAccessibleStringGrid, fFrame;139 uses ORFn, uConst, rODMeds, rODBase, fFrame, uCore, fOtherSchedule, rCore; 88 140 89 141 const … … 108 160 TX_NO_UNITS = 'Units must be entered for '; 109 161 TX_NO_RATE = 'An infusion rate must be entered.'; 110 TX_BAD_RATE = 'The infusion rate must be: # ml/hr or text@labels per day'; 162 //TX_BAD_RATE = 'The infusion rate must be: # ml/hr or text@labels per day'; 163 TX_BAD_RATE = 'Infusion rate can only be up to 4 digits long or' + CRLF + 'Infusion rate must be # ml/hr or text@labels per day'; 164 TX_NO_INFUSION_TIME = 'An Infusion length must be entered or the Unit of Time for the Infuse Over Time field needs to be cleared out.'; 165 TX_NO_SCHEDULE = 'A schedule is required for an intermittent order.'; 166 TX_BAD_SCHEDULE = 'Unable to resolve non-standard schedule.'; 167 TX_NO_INFUSION_UNIT = 'Invalid Unit of Time, select either "Minutes" or "Hours" for the Infusion Length'; 168 TX_BAD_ROUTE = 'Route cannot be free-text'; 169 TX_LEADING_NUMERIC = 'this additive must start with a leading numeric value'; 111 170 112 171 (* … … 131 190 begin 132 191 frmFrame.pnlVisit.Enabled := false; 192 //AutoSizeDisabled := true; 133 193 inherited; 134 194 AllowQuickOrder := True; … … 147 207 CtrlInits.LoadDefaults(ODForIVFluids); // ODForIVFluids returns TStrings with defaults 148 208 InitDialog; 149 TAccessibleStringGrid.WrapControl(grdSelected);150 209 end; 151 210 … … 154 213 i: Integer; 155 214 begin 156 TAccessibleStringGrid.UnwrapControl(grdSelected);157 215 with grdSelected do for i := 0 to RowCount - 1 do TIVComponent(Objects[0, i]).Free; 158 216 inherited; … … 161 219 162 220 procedure TfrmODMedIV.FormResize(Sender: TObject); 221 var 222 bottom: integer; 163 223 begin 164 224 inherited; … … 170 230 end; 171 231 lblAmount.Left := grdSelected.Left + grdSelected.ColWidths[0]; 232 self.cboType.SelLength := 0; 233 self.cboInfusionTime.SelLength := 0; 234 self.cboDuration.SelLength := 0; 235 bottom := self.cboPriority.Top + self.cboPriority.Height; 236 if self.chkDoseNow.Top < bottom then self.chkDoseNow.Top := bottom + 5; 237 self.txtRate.Height := self.cboInfusionTime.Height; 238 self.txtXDuration.Height := self.cboDuration.Height; 239 self.lblAdminTime.Height := TextHeightByFont(self.lblAdminTime.Font.Handle, 'A'); 240 self.lblFirstDose.Height := TextHeightByFont(self.lblFirstDose.Font.Handle, 'A'); 241 self.lblAdminTime.Width := TextWidthByFont(self.lblAdminTime.Font.Handle, self.lblAdminTime.Caption + ' '); 242 self.lblFirstDose.Width := TextWidthByFont(self.lblFirstDose.Font.Handle, self.lblFirstDose.Caption + ' '); 243 self.lblAdminTime.Top := self.chkDoseNow.Top + self.chkDoseNow.Height + 2; 244 self.lblFirstDose.Top := self.lblAdminTime.Top + self.lblAdminTime.Height + 2; 245 if self.Label1.Top < (self.lblFirstDose.Top + self.lblFirstDose.Height) then 246 begin 247 self.Label1.Top := self.lblFirstDose.Top + self.lblFirstDose.Height + 2; 248 self.memOrder.Top := self.Label1.Top + self.Label1.Height; 249 end; 172 250 end; 173 251 … … 182 260 inherited; 183 261 //grdSelected.Selection := NOSELECTION; 262 //FRouteConflict := False; 263 //lblTypeHelp.Hint := IVTypeHelpText; 264 lblType.Hint := IVTypeHelpText; 265 cboType.Hint := IVTYpeHelpText; 184 266 with grdSelected do for i := 0 to RowCount - 1 do 185 267 begin … … 194 276 cboSolution.InsertSeparator; 195 277 SetControl(cboPriority, 'Priorities'); 278 cboType.Items.Add('Continuous'); 279 cboType.Items.Add('Intermittent'); 280 cboType.ItemIndex := -1; 281 cboType.SelLength := 0; 282 //SetControl(cboRoute, 'Route'); 283 if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then cboRoute.Text := ''; 284 //SetControl(cboSchedule, 'Schedules'); 285 LoadSchedules(cboSchedule.Items, patient.Inpatient); 286 //if (Patient.Inpatient) and (cboSchedule.Items.IndexOfName('Other')<0) then 287 if cboSchedule.Items.IndexOf('Other') = -1 then cboSchedule.Items.Add('OTHER'); 288 289 cboSchedule.Enabled := False; 290 lblschedule.Enabled := False; 291 if cboInfusionTime.Items.Count = 0 then 292 begin 293 cboInfusionTime.Items.add('Minutes'); 294 cboInfusionTime.Items.Add('Hours'); 295 end; 296 cboInfusionTime.Enabled := false; 297 updateDuration(''); 298 if cboDuration.Items.Count = 0 then 299 begin 300 cboDuration.Items.Add('L'); 301 cboDuration.Items.Add('ml'); 302 cboDuration.Items.Add('days'); 303 cboDuration.Items.Add('hours'); 304 end; 305 cboDuration.ItemIndex := -1; 306 cboDuration.Text := ''; 307 if self.txtXDuration.Text <> '' then self.txtXDuration.Text := ''; 308 txtNSS.Visible := false; 309 if (chkDoseNow.Visible = true) and (chkDoseNow.Checked = true) then chkDoseNow.Checked := false; 310 chkDoseNow.Visible := false; 311 chkPRN.Enabled := false; 196 312 end; 197 313 tabFluid.TabIndex := 0; … … 199 315 cboSolution.InitLongList(''); 200 316 cboAdditive.InitLongList(''); 317 JAWSON := true; 318 if ScreenReaderActive = false then 319 begin 320 lblAdminTime.TabStop := false; 321 lblFirstDose.TabStop := false; 322 memOrder.TabStop := false; 323 JAWSON := false; 324 end; 201 325 ActiveControl := cboSolution; //SetFocusedControl(cboSolution); 202 326 StatusText(''); 327 OSolIEN := 0; 328 OAddIEN := 0; 329 OSchedule := ''; 330 oAdmin := ''; 331 self.txtAllIVRoutes.Visible := false; 332 end; 333 334 function TfrmODMedIV.IVTypeHelpText: string; 335 begin 336 result := 'Continuous Type:' + CRLF + ' IVs that run at a specified Rate ( __ml/hr, __mcg/kg/min, etc)' + 337 CRLF + CRLF + 'Intermittent Type:' + CRLF + 338 ' IVs administered at scheduled intervals (Q4H, QDay) or One-Time only, ' + 339 CRLF + ' over a specified time period (e.g. Infuse over 30 min.).' + CRLF + CRLF + 340 'Examples:' + CRLF + 'Continuous = Infusion/drip' + CRLF + 'Intermittent = IVP/IVPB'; 341 end; 342 343 procedure TfrmODMedIV.lblTypeHelpClick(Sender: TObject); 344 var 345 str: string; 346 begin 347 inherited; 348 str := IVTypeHelpText; 349 infoBox(str, 'Informational Help Text', MB_OK); 350 end; 351 352 353 procedure TfrmODMedIV.loadExpectFirstDose; 354 var 355 i: integer; 356 AnIVComponent: TIVComponent; 357 fAddIEN, fSolIEN, Interval, idx: integer; 358 AdminTime: TFMDateTime; 359 Admin, Duration, ShowText, SchTxt, SchType, IVType: string; 360 doseNow, calFirstDose: boolean; 361 begin 362 idx := self.cboSchedule.ItemIndex; 363 IVType := self.cboType.Items.Strings[self.cboType.itemindex]; 364 if idx = -1 then 365 begin 366 if IVType = 'Continuous' then 367 begin 368 self.lblFirstDose.Caption := ''; 369 self.lblFirstDose.Visible := false; 370 end; 371 exit; 372 end; 373 doseNow := true; 374 SchType := Piece(self.cboSchedule.Items.Strings[idx],U,3); 375 if self.EvtID > 0 then doseNow := false; 376 if (IVType = 'Continuous') or ((idx > -1) and ((SchType = 'P') or (SchType = 'O') or (SchType = 'OC')) or 377 (self.chkPRN.Checked = True)) then 378 begin 379 self.lblFirstDose.Caption := ''; 380 self.lblAdminTime.Caption := ''; 381 self.lblFirstDose.Visible := false; 382 self.lblAdminTime.Visible := false; 383 self.lblAdminTime.TabStop := false; 384 self.lblFirstDose.TabStop := false; 385 if (self.cboType.Text = 'Continuous') or (Piece(self.cboSchedule.Items.Strings[idx],U,3) = 'O') then doseNow := false; 386 if chkDoseNow.Checked = true then lblFirstDose.Visible := false; 387 if idx > -1 then oSchedule := Piece(self.cboSchedule.Items.Strings[idx],U,1); 388 if (self.chkPRN.Checked = True) and (idx > -1) and (LeftStr(Piece(self.cboSchedule.Items.Strings[idx],U,1),3)<> 'PRN') then 389 OSchedule := Piece(self.cboSchedule.Items.Strings[idx],U,1) + ' PRN'; 390 DisplayDoseNow(doseNow); 391 exit; 392 // end; 393 end 394 else if SchType <> 'O' then 395 begin 396 self.lblAdminTime.Visible := true; 397 if FAdminTimeText <> '' then self.lblAdminTime.Caption := 'Admin. Time: ' + FAdminTimeText 398 else if Piece(self.cboSchedule.Items[idx],U,4) <> '' then 399 self.lblAdminTime.Caption := 'Admin. Time: ' + Piece(self.cboSchedule.Items[idx],U,4) 400 else self.lblAdminTime.Caption := 'Admin. Time: Not Defined'; 401 end; 402 DisplayDoseNow(doseNow); 403 if chkDoseNow.Checked = true then 404 begin 405 lblFirstDose.Visible := false; 406 Exit; 407 end; 408 self.lblFirstDose.Visible := True; 409 fSolIEN := 0; 410 fAddIEN := 0; 411 for i := 0 to self.grdSelected.RowCount - 1 do 412 begin 413 AniVComponent := TIVComponent(self.grdSelected.Objects[0, i]); 414 if AnIVComponent = nil then Continue; 415 if (AnIVComponent.Fluid = 'B') and (fSolIEN = 0) then fSolIEN := AnIVComponent.IEN; 416 if (AnIVComponent.Fluid = 'A') and (fAddIEN = 0) then fAddIEN := AnIVComponent.IEN; 417 if (fSolIEN > 0) and (fAddIEN > 0) then break; 418 end; 419 SchTxt := self.cboSchedule.Text; 420 Admin := ''; 421 if (self.lblAdminTime.visible = True) and (self.lblAdminTime.Caption <> '') then 422 begin 423 Admin := Copy(self.lblAdminTime.Caption, 14, (Length(self.lblAdminTime.Caption)-1)); 424 if not (Admin[1] in ['0'..'9']) then Admin := ''; 425 end; 426 if (fSolIEN = oSolIEN) and (fAddIEN = oAddIEN) and (OSchedule = SchTxt) and (oAdmin = Admin) then CalFirstDose := false 427 else 428 begin 429 CalFirstDose := True; 430 oSolIEN := fSolIEN; 431 oAddIEN := fAddIEN; 432 oSchedule := SchTxt; 433 oAdmin := Admin; 434 end; 435 if CalFirstDose = True then 436 begin 437 if fAddIEN > 0 then LoadAdminInfo(';' + schTxt, fAddIEN, ShowText, AdminTime, Duration, Admin) 438 else LoadAdminInfo(';' + schTxt, fSolIEN, ShowText, AdminTime, Duration, Admin); 439 if AdminTime > 0 then 440 begin 441 ShowText := 'Expected First Dose: '; 442 Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday)); 443 case Interval of 444 0: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime); 445 1: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime); 446 else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime); 447 end; 448 end; 449 self.lblFirstDose.Caption := ShowText; 450 end; 451 if (self.lblFirstDose.Visible = true) and (self.lblFirstDose.Caption <> '') and (JAWSON = true) then self.lblFirstDose.TabStop := true 452 else self.lblFirstDose.TabStop := false; 453 if (self.lblAdminTime.Visible = true) and (self.lblAdminTime.Caption <> '') and (JAWSON = true) then self.lblAdminTime.TabStop := true 454 else self.lblAdminTime.TabStop := false; 203 455 end; 204 456 205 457 procedure TfrmODMedIV.Validate(var AnErrMsg: string); 206 458 var 207 ItemOK: Boolean;208 x: string;209 i: Integer;459 DispWarning, ItemOK, Result: Boolean; 460 LDec,RDec,x, tempStr, iunit, infError: string; 461 digits, i, j, Len, temp, Value: Integer; 210 462 211 463 procedure SetError(const x: string); … … 221 473 ItemOK := False; 222 474 for i := 0 to RowCount - 1 do 223 if TIVComponent(Objects[0, i]).Fluid = 'B' then ItemOK := True; 224 if not ItemOK then SetError(TX_NO_BASE); 475 if (Objects[0,i] <> nil) and (TIVComponent(Objects[0, i]).Fluid = 'B') then ItemOK := True; 476 if (not ItemOK) and ((self.cboType.ItemIndex = -1) or (MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous')) then 477 SetError(TX_NO_BASE); 225 478 for i := 0 to RowCount - 1 do 226 479 begin … … 229 482 if (Objects[0, i] <> nil) and (Length(Cells[2, i]) = 0) 230 483 then SetError(TX_NO_UNITS + Cells[0, i]); 231 end; 232 end; 233 if Length(txtRate.Text) = 0 then SetError(TX_NO_RATE) else 234 begin 235 x := Trim(txtRate.Text); 236 ValidateIVRate(x); 237 if Length(x) = 0 then SetError(TX_BAD_RATE) else Responses.Update('RATE', 1, x, x); 238 end; 484 if (Objects[0,i] <> nil) and (TIVComponent(Objects[0, i]).Fluid = 'A') then 485 begin 486 temp := Pos('.', Cells[1, i]); 487 if temp > 0 then 488 begin 489 tempStr := Cells[1, i]; 490 if temp = 1 then 491 begin 492 SetError(cells[0, i] + TX_LEADING_NUMERIC); 493 Exit; 494 end; 495 for j := 1 to temp -1 do if not (tempStr[j] in ['0'..'9']) then 496 begin 497 SetError(cells[0, i] + TX_LEADING_NUMERIC); 498 Exit; 499 end; 500 end; 501 end; 502 end; 503 end; 504 if Pos(U, self.memComments.Text) > 0 then SetError('Comments cannot contain a "^".'); 505 if cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex], U, 3)); 506 if self.cboPriority.Text = '' then SetError('Priority is required'); 507 if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then SetError(TX_BAD_ROUTE); 508 if (cboRoute.ItemIndex > -1) and (cboRoute.ItemIndex = cboRoute.Items.IndexOf('OTHER')) then 509 SetError('A valid route must be selected'); 510 if self.cboRoute.Text = '' then SetError('Route is required'); 511 if (self.txtXDuration.Text <> '') and (self.cboduration.Items.IndexOf(SELF.cboDuration.Text) = -1) then 512 SetError('A valid duration type is required'); 513 if (self.txtXDuration.Text = '') and (self.cboduration.Items.IndexOf(SELF.cboDuration.Text) > -1) then 514 SetError('Cannot have a duration type without a duration value'); 515 516 if self.cboType.ItemIndex = -1 then 517 begin 518 SetError('IV Type is required'); 519 Exit; 520 end; 521 if MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous' then 522 begin 523 if Length(txtRate.Text) = 0 then SetError(TX_NO_RATE) else 524 begin 525 x := Trim(txtRate.Text); 526 if pos('@', X) > 0 then 527 begin 528 LDec := Piece(x, '@', 1); 529 RDec := Piece(x, '@', 2); 530 if (Length(RDec) = 0) or (Length(RDec) > 2) then x := ''; 531 end 532 else if Pos('.',X)>0 then 533 begin 534 LDec := Piece(x, '.', 1); 535 RDec := Piece(x, '.', 2); 536 if Length(LDec) = 0 then SetError('Infusion Rate required a leading numeric value'); 537 if Length(RDec) > 1 then SetError('Infusion Rate cannot exceed one decimal place'); 538 end 539 else if LeftStr(txtRate.Text, 1) = '0' then 540 SetError('Infusion Rate cannot start with a zero.'); 541 if ( Pos('@',x)=0) then 542 begin 543 if (Length(x) > 4) then 544 begin 545 seterror(TX_BAD_RATE); 546 exit; 547 end; 548 for i := 1 to Length(x) do 549 begin 550 if not (x[i] in ['0'..'9']) and (x[i] <> '.') then 551 begin 552 SetError(TX_BAD_RATE); 553 exit; 554 end; 555 end; 556 end; 557 if (pos('ml/hr', X) = 0) and (Length(x) > 0) and (pos('@', X) = 0) then X := X + ' ml/hr'; 558 if Length(x) = 0 then SetError(TX_BAD_RATE) else Responses.Update('RATE', 1, x, x); 559 end; 560 if cboduration.text = 'doses' then SetError('Continuous Orders cannot have "doses" as a duration type'); 561 end 562 else if MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Intermittent' then 563 begin 564 if (cboInfusionTime.ItemIndex = -1) and (txtRate.Text <> '') then SetError(TX_NO_INFUSION_UNIT); 565 if (txtRate.Text = '') and (cboInfusionTime.ItemIndex > -1) then SetError(TX_NO_INFUSION_TIME); 566 if (txtRate.Text <> '') then 567 begin 568 infError := ''; 569 InfError := ValidateInfusionRate(txtRate.Text); 570 if infError <> '' then SetError(InfError); 571 Len := Length(txtRate.Text); 572 iunit := MixedCase(self.cboInfusionTime.Items.Strings[cboInfusionTime.ItemIndex]); 573 if (iunit = 'Minutes') and (Len > 4) then setError('Infuse Over Time cannot exceed 4 spaces for ' + iunit) 574 else if (iunit = 'Hours') and (Len > 2) then setError('Infuse Over Time cannot exceed 2 spaces for ' + iunit); 575 end; 576 if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text = '') then SetError(TX_NO_SCHEDULE); 577 if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then SetError(TX_BAD_SCHEDULE); 578 end; 579 if txtXDuration.Text = '' then 580 begin 581 if AnErrMsg = '' then self.FInitialOrderID := True; 582 exit; 583 end; 584 Len := Length(txtXDuration.Text); 585 if LeftStr(txtXDuration.Text,1) <> '.' then 586 begin 587 DispWarning := false; 588 Digits := 2; 589 if cboDuration.text = 'ml' then digits := 4; 590 if ((cboDuration.text = 'days') or (cboDuration.text = 'hours')) and (Len > digits) then 591 DispWarning := true 592 else if (cboduration.text = 'ml') and (Len > digits) then DispWarning := true 593 else if (cboduration.text = 'L') and (Len > digits) and (Pos('.',txtXDuration.Text) = 0) then DispWarning := True; 594 if DispWarning = true then SetError('Duration for ' + cboduration.text + ' cannot be greater than ' + InttoStr(digits) + ' digits.'); 595 end; 596 if (Pos('.', txtXDuration.Text)>0) then 597 begin 598 SetError('Invalid Duration, please enter a whole numbers for a duration.'); 599 end 600 else if LeftStr(txtXDuration.text, 1) = '0' then 601 SetError('Duration cannot start with a zero.'); 602 if (cboduration.text = 'doses') then 603 begin 604 if TryStrToInt(txtXDuration.Text, Value) = false then 605 SetError('Duration with a unit of "doses" must be a whole number between 0 and 2000000') 606 else if (Value < 0) or (Value > 2000000) then 607 SetError('Duration with a unit of "doses" must be greater then 0 and less then 2000000'); 608 end; 609 if AnErrMsg = '' then self.FInitialOrderID := True; 610 611 end; 612 613 function TFrmODMedIV.ValidateInfusionRate(Rate: string): string; 614 var 615 Temp: Boolean; 616 i: integer; 617 begin 618 Temp := False; 619 if Pos('.',Rate) >0 then 620 begin 621 Result := 'Infuse Over Time can only be a whole number'; 622 exit; 623 end 624 else if LeftStr(Rate, 1) = '0' then Result := 'Infuse Over Time cannot start with a zero.'; 625 for i := 1 to Length(Rate) do if not (Rate[i] in ['0'..'9']) then Temp := True; 626 if Temp = True then Result := 'The Infusion time can only be a whole number'; 239 627 end; 240 628 241 629 procedure TfrmODMedIV.SetValuesFromResponses; 242 630 var 243 x : string;244 AnInstance : Integer;631 x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute: string; 632 AnInstance, i, idx: Integer; 245 633 AResponse: TResponse; 246 634 AnIVComponent: TIVComponent; 635 AllIVRoute: TStringList; 636 PQO: boolean; 247 637 begin 248 638 Changing := True; 639 self.FInitialOrderID := false; 249 640 with Responses do 250 641 begin … … 265 656 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK); 266 657 cboAdditive.Text := ''; 658 AbortOrder := True; 267 659 Exit; 268 660 end; … … 273 665 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK); 274 666 cboAdditive.Text := ''; 667 AbortOrder := True; 275 668 Exit; 276 669 end; … … 310 703 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK); 311 704 cboAdditive.Text := ''; 705 AbortOrder := True; 312 706 Exit; 313 707 end; … … 318 712 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK); 319 713 cboAdditive.Text := ''; 714 AbortOrder := true; 320 715 Exit; 321 716 end; … … 342 737 AnInstance := NextInstance('ADDITIVE', AnInstance); 343 738 end; {while AnInstance - ADDITIVE} 344 SetControl(txtRate, 'RATE', 1); 345 if LowerCase(Copy(ReverseStr(txtRate.Text), 1, 6)) = 'rh/lm ' {*kcm*} 346 then txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6); 739 SetControl(cboType, 'TYPE', 1); 740 if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True; 741 updateRoute; 742 AResponse := FindResponseByName('ROUTE', 1); 743 if AResponse <> nil then 744 begin 745 tempRoute := AResponse.EValue; 746 if tempRoute <> '' then 747 begin 748 idx := self.cboRoute.Items.IndexOf(tempRoute); 749 if idx > -1 then self.cboRoute.ItemIndex := idx 750 else begin 751 tempIRoute := AResponse.IValue; 752 if tempIRoute <> '' then 753 begin 754 AllIVRoute := TStringList.Create; 755 LoadAllIVRoutes(AllIVRoute); 756 idx := -1; 757 for i := 0 to AllIVRoute.Count - 1 do 758 begin 759 if Piece(AllIVRoute.Strings[i], U, 1) = tempIRoute then 760 begin 761 idx := i; 762 break; 763 end; 764 end; 765 if idx > -1 then 766 begin 767 self.cboRoute.Items.Add(AllIVRoute.Strings[idx]); 768 idx := self.cboRoute.Items.IndexOf(tempRoute); 769 if idx > -1 then self.cboRoute.ItemIndex := idx; 770 end; 771 AllIVRoute.Free; 772 //if Pos(U, tempIRoute) = 0 then tempIRoute := tempIRoute + U + tempRoute; 773 //self.cboRoute.Items.Add(tempIRoute); 774 //idx := self.cboRoute.Items.IndexOf(tempRoute); 775 //if idx > -1 then self.cboRoute.ItemIndex := idx; 776 end; 777 end; 778 end; 779 end; 780 //SetControl(cboRoute, 'ROUTE', 1); 781 if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then cboRoute.Text := ''; 782 if self.cboType.Text = 'Intermittent' then 783 begin 784 lblInfusionRate.Caption := 'Infuse Over Time (Optional)'; 785 lblSchedule.Enabled := True; 786 cboschedule.Enabled := True; 787 //if popDuration.Items.IndexOf(popDoses) = -1 then popDuration.Items.Add(popDoses); 788 if cboDuration.Items.IndexOf('doses') = -1 then cboDuration.Items.Add('doses'); 789 txtNss.Visible := true; 790 chkDoseNow.Visible := true; 791 chkPRN.Enabled := True; 792 tempSch := ''; 793 AdminTime := ''; 794 AResponse := FindResponseByName('SCHEDULE', 1); 795 if AResponse <> nil then tempSch := AResponse.EValue; 796 lblAdminTime.Visible := True; 797 lblAdminTime.Hint := AdminTimeHelpText; 798 lblAdminTime.ShowHint := True; 799 //AResponse := Responses.FindResponseByName('ADMIN', 1); 800 //if AResponse <> nil then AdminTime := AResponse.EValue; 801 //if Action = Order_Copy then FOriginalAdminTime := AdminTime; 802 SetSchedule(tempSch); 803 //if (cboSchedule.ItemIndex > -1) then lblAdminTime.Caption := 'Admin. Time: ' + Piece(cboSchedule.Items.strings[cboSchedule.itemindex],U,5); 804 //if (cboSchedule.ItemIndex > -1) and (Piece(lblAdminTime.Caption, ':' ,2) = ' ') then lblAdminTime.Caption := 'Admin. Time: ' + AdminTime; 805 if (Action in [ORDER_COPY, ORDER_EDIT]) then 806 begin 807 TempOrder := Piece(OrderIEN,';',1); 808 TempOrder := Copy(tempOrder, 2, Length(tempOrder)); 809 if DifferentOrderLocations(tempOrder, Patient.Location) = false then 810 begin 811 AResponse := Responses.FindResponseByName('ADMIN', 1); 812 if AResponse <> nil then AdminTime := AResponse.EValue; 813 //lblAdminTime.Caption := 'Admin. Time: ' + AdminTime; 814 if cboSchedule.ItemIndex > -1 then 815 begin 816 tmpSch := cboSchedule.Items.Strings[cboSchedule.itemindex]; 817 setPiece(tmpSch,U,4,AdminTime); 818 cboSchedule.Items.Strings[cboSchedule.ItemIndex] := tmpSch; 819 end; 820 end; 821 end; 822 //if Piece(lblAdminTime.Caption, ':' ,2) = ' ' then lblAdminTime.Caption := 'Admin. Time: Not Defined'; 823 SetControl(txtRate, 'RATE', 1); 824 cboInfusionTime.Enabled := true; 825 PQO := false; 826 if Pos('INFUSE OVER',UpperCase(txtRate.Text)) > 0 then 827 begin 828 txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text)); 829 PQO := True; 830 end; 831 if Pos('MINUTE',UpperCase(txtRate.Text))>0 then 832 begin 833 cboInfusionTime.Text := 'Minutes'; 834 cboInfusionTime.itemindex := 0; 835 //txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text)); 836 txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 8); 837 end 838 else if Pos('HOUR',UpperCase(txtRate.Text))>0 then 839 begin 840 cboInfusionTime.Text := 'Hours'; 841 cboInfusionTime.ItemIndex := 1; 842 //txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text)); 843 txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6); 844 end 845 else if (txtRate.Text <> '') and (PQO = false) and (ValidateInfusionRate(txtRate.Text) ='') then 846 begin 847 cboInfusionTime.Text := 'Minutes'; 848 cboInfusionTime.itemindex := 0; 849 end; 850 end 851 else 852 begin 853 lblSchedule.Enabled := false; 854 cboSchedule.ItemIndex := -1; 855 cboSchedule.Enabled := false; 856 if chkDoseNow.Visible = true then chkDoseNow.Checked := false; 857 chkDoseNow.Visible := false; 858 txtNSS.Visible := false; 859 cboInfusionTime.ItemIndex := -1; 860 cboInfusionTime.Text := ''; 861 cboInfusionTime.Enabled := false; 862 chkPRN.Checked := false; 863 chkPRN.Enabled := false; 864 txtRate.Text := ''; 865 cboDuration.ItemIndex := -1; 866 cboDuration.Text := ''; 867 txtXDuration.Text := ''; 868 SetControl(txtRate, 'RATE', 1); 869 if LowerCase(Copy(ReverseStr(txtRate.Text), 1, 6)) = 'rh/lm ' {*kcm*} 870 then txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6); 871 end; 347 872 SetControl(cboPriority, 'URGENCY', 1); 348 873 SetControl(memComments, 'COMMENT', 1); … … 357 882 end; {if...with Responses} 358 883 Changing := False; 884 if self.cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3)); 885 loadExpectFirstDose; 359 886 ControlChange(Self); 360 887 end; … … 363 890 begin 364 891 inherited; 365 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then SetValuesFromResponses; 892 Action := OrderAction; 893 OrderIEN := id; 894 self.FInitialOrderID := True; 895 if self.EvtID > 0 then FAdminTimeText := 'To Be Determined'; 896 if (isIMO) or ((patient.Inpatient = true) and (encounter.Location <> patient.Location)) and (FAdminTimeText = '') then 897 FAdminTimeText := 'Not defined for Clinic Locations'; 898 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then 899 begin 900 901 SetValuesFromResponses; 902 end; 366 903 end; 367 904 … … 400 937 end; 401 938 939 procedure TfrmODMedIV.cbotypeChange(Sender: TObject); 940 begin 941 inherited; 942 //if (self.cbotype.Text = 'Intermittent') or (self.cboType.itemIndex = 1) then 943 if (self.cboType.itemIndex = 1) then 944 begin 945 cboSchedule.ItemIndex := -1; 946 lblAdminTime.Caption := ''; 947 lblAdminTime.Visible := false; 948 lblschedule.Enabled := True; 949 cboSchedule.Enabled := True; 950 txtNSS.Visible := true; 951 chkDoseNow.Checked := false; 952 chkDoseNow.Visible := true; 953 chkPRN.Checked := false; 954 chkPRN.Enabled := True; 955 lblInfusionRate.Caption := 'Infuse Over Time (Optional)'; 956 cboInfusionTime.Enabled := true; 957 cboDuration.Items.Add('doses'); 958 end 959 //else if (self.cbotype.Text = 'Continuous') or (self.cboType.itemIndex = 0) then 960 else 961 begin 962 lblschedule.Enabled := False; 963 cboSchedule.ItemIndex := -1; 964 cboSchedule.Enabled := False; 965 txtNSS.Visible := false; 966 chkPRN.Checked := false; 967 chkPRN.Enabled := false; 968 if chkDoseNow.Visible = true then chkDoseNow.Checked := false; 969 chkDoseNow.Visible := false; 970 lblInfusionRate.Caption := 'Infusion Rate (ml/hr)*'; 971 cboInfusionTime.ItemIndex := -1; 972 cboInfusionTime.Text := ''; 973 cboInfusionTime.Enabled := false; 974 lblAdminTime.Visible := false; 975 updateDuration(''); 976 cboduration.Items.Delete(cboDuration.Items.IndexOf('doses')); 977 end; 978 self.txtRate.Text := ''; 979 ControlChange(Sender); 980 end; 981 982 procedure TfrmODMedIV.chkDoseNowClick(Sender: TObject); 983 Const 984 T = '"'; 985 T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication.'; 986 T2 = #13#13'The first order''s administrative schedule is "'; 987 T3 = #13'The second order''s administrative schedule is "'; 988 T4 = #13#13'Do you want to continue?'; 989 T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"'; 990 T2A = ' in addition to the one you are placing for the same medication.'; 991 var 992 medNm: string; 993 theSch: string; 994 //SchID: integer; 995 begin 996 inherited; 997 if (chkDoseNow.Checked) then 998 begin 999 medNm := 'Test'; 1000 //SchID := cboSchedule.ItemIndex; 1001 theSch := cboSchedule.Text; 1002 if length(theSch)>0 then 1003 begin 1004 //if (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then 1005 if (InfoBox(T1+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then 1006 begin 1007 chkDoseNow.Checked := False; 1008 Exit; 1009 end; 1010 end else 1011 begin 1012 //if InfoBox(T1A+T2A+medNm+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then 1013 if InfoBox(T1A+T2A+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then 1014 begin 1015 chkDoseNow.Checked := False; 1016 Exit; 1017 end; 1018 end; 1019 end; 1020 ControlChange(self); 1021 end; 1022 1023 procedure TfrmODMedIV.chkPRNClick(Sender: TObject); 1024 begin 1025 inherited; 1026 ControlChange(Self); 1027 end; 1028 402 1029 procedure TfrmODMedIV.cboSolutionMouseClick(Sender: TObject); 403 1030 var 404 1031 AnIVComponent: TIVComponent; 405 x: string; 1032 x,routeIEN: string; 1033 i: integer; 406 1034 begin 407 1035 inherited; 408 1036 if CharAt(cboSolution.ItemID, 1) = 'Q' then // setup quick order 409 1037 begin 1038 //Clear pre-existing values 1039 for i := 0 to self.grdSelected.RowCount do 1040 begin 1041 if self.grdSelected.Objects[0,i] <> nil then 1042 begin 1043 TIVComponent(self.grdSelected.Objects[0,i]).Free; 1044 self.grdSelected.Rows[i].Clear; 1045 end 1046 else self.grdSelected.Rows[i].clear; 1047 end; 1048 self.grdSelected.RowCount := 0; 1049 ControlChange(Sender); 410 1050 Responses.QuickOrder := ExtractInteger(cboSolution.ItemID); 411 1051 SetValuesFromResponses; … … 432 1072 end; 433 1073 end; 434 1074 RouteIEN := Piece(cboSolution.Items.Strings[cboSolution.itemindex],U,4); 435 1075 x := AmountsForIVFluid(cboSolution.ItemIEN, 'B'); 436 1076 AnIVComponent := TIVComponent.Create; … … 459 1099 Application.ProcessMessages; //CQ: 10157 460 1100 ClickOnGridCell; 1101 updateRoute; 461 1102 ControlChange(Sender); 1103 //updateRoute(routeIEN); 462 1104 end; 463 1105 … … 465 1107 begin 466 1108 inherited; 467 if cboSolution.ItemIEN > 0 then cboSolutionMouseClick(Self); 1109 if EnterIsPressed then //CQ: 15097 1110 if (cboSolution.ItemIEN > 0) or 1111 ((cboSolution.ItemIEN = 0) and (CharAt(cboSolution.ItemID, 1) = 'Q')) then 1112 cboSolutionMouseClick(Self); 468 1113 end; 469 1114 … … 481 1126 end; 482 1127 1128 procedure TfrmODMedIV.cboDurationChange(Sender: TObject); 1129 begin 1130 inherited; 1131 if (FOriginalDurationType > -1) and (FOriginalDurationType <> cboDuration.ItemIndex) then 1132 begin 1133 self.txtXDuration.Text := ''; 1134 FOriginalDurationType := cboDuration.ItemIndex; 1135 end; 1136 if (FOriginalDurationType = -1) and (cboDuration.ItemIndex > -1) then FOriginalDurationType := cboDuration.ItemIndex; 1137 controlchange(sender); 1138 end; 1139 1140 procedure TfrmODMedIV.cboDurationEnter(Sender: TObject); 1141 begin 1142 inherited; 1143 FOriginalDurationType := cboDuration.ItemIndex; 1144 end; 1145 1146 1147 procedure TfrmODMedIV.cboInfusionTimeChange(Sender: TObject); 1148 begin 1149 inherited; 1150 if (FOriginalInfusionType > -1) and (FOriginalInfusionType <> cboInfusionTime.ItemIndex) then 1151 begin 1152 self.txtRate.Text := ''; 1153 FOriginalInfusionType := cboInfusionTime.ItemIndex; 1154 end; 1155 if (FOriginalInfusionType = -1) and (cboInfusionTime.ItemIndex > -1) then FOriginalInfusionType := cboInfusionTime.ItemIndex; 1156 ControlChange(Sender); 1157 end; 1158 1159 procedure TfrmODMedIV.cboInfusionTimeEnter(Sender: TObject); 1160 begin 1161 inherited; 1162 FOriginalInfusionType := self.cboInfusionTime.ItemIndex; 1163 end; 1164 1165 procedure TfrmODMedIV.cboPriorityChange(Sender: TObject); 1166 begin 1167 inherited; 1168 ControlChange(sender); 1169 end; 1170 1171 procedure TfrmODMedIV.cboPriorityExit(Sender: TObject); 1172 begin 1173 inherited; 1174 if cboPriority.Text = '' then 1175 begin 1176 infoBox('Priority must have a value assigned to it', 'Warning', MB_OK); 1177 cboPriority.SetFocus; 1178 end; 1179 end; 1180 1181 procedure TfrmODMedIV.cboRouteChange(Sender: TObject); 1182 begin 1183 inherited; 1184 if cboRoute.ItemIndex = cboRoute.Items.IndexOf('OTHER') then cboRouteClick(cboRoute); 1185 ControlChange(sender); 1186 end; 1187 1188 procedure TfrmODMedIV.cboRouteClick(Sender: TObject); 1189 var 1190 otherRoute, temp: string; 1191 idx, oidx: integer; 1192 begin 1193 inherited; 1194 oidx := cboRoute.Items.IndexOf('OTHER'); 1195 if oidx = -1 then exit; 1196 1197 if cboRoute.ItemIndex = oidx then 1198 begin 1199 otherRoute := CreateOtherRoute; 1200 if length(otherRoute) > 1 then 1201 begin 1202 idx := cboRoute.Items.IndexOf(Piece(OtherRoute, U, 2)); 1203 if idx > -1 then 1204 begin 1205 temp := cboRoute.Items.Strings[idx]; 1206 //setPiece(temp,U,5,'1'); 1207 cboRoute.Items.Strings[idx] := temp; 1208 end 1209 else 1210 begin 1211 cboRoute.Items.Add(otherRoute); 1212 idx := cboRoute.Items.IndexOf(Piece(OtherRoute, U, 2)); 1213 end; 1214 cboRoute.ItemIndex := idx; 1215 end 1216 else 1217 begin 1218 cboRoute.ItemIndex := -1; 1219 cboRoute.SetFocus; 1220 end; 1221 end; 1222 end; 1223 1224 procedure TfrmODMedIV.cboRouteExit(Sender: TObject); 1225 begin 1226 inherited; 1227 (* if (cboRoute.Text <> '') and (cboRoute.ItemIndex = -1) then 1228 begin 1229 infoBox(TX_BAD_ROUTE,'Warning',MB_OK); 1230 cboRoute.SetFocus; 1231 end; *) 1232 end; 1233 483 1234 procedure TfrmODMedIV.cboAdditiveMouseClick(Sender: TObject); 484 1235 var 485 1236 AnIVComponent: TIVComponent; 486 x : string;1237 x, routeIEN: string; 487 1238 begin 488 1239 inherited; … … 506 1257 end; 507 1258 end; 1259 routeIEN := Piece(cboAdditive.Items.Strings[cboAdditive.itemindex],U,4); 508 1260 x := AmountsForIVFluid(cboAdditive.ItemIEN, 'A'); 509 1261 AnIVComponent := TIVComponent.Create; … … 526 1278 Application.ProcessMessages; //CQ: 10157 527 1279 ClickOnGridCell; 1280 updateRoute; 528 1281 ControlChange(Sender); 1282 //UpdateRoute(RouteIEN); 529 1283 end; 530 1284 … … 532 1286 begin 533 1287 inherited; 534 if cboAdditive.ItemIEN > 0 then cboAdditiveMouseClick(Self); 1288 if (cboAdditive.ItemIEN > 0) and (EnterIsPressed) then 1289 cboAdditiveMouseClick(Self); 535 1290 end; 536 1291 537 1292 { grdSelected events } 1293 1294 procedure TfrmODMedIV.ClearAllFields; 1295 begin 1296 self.cboType.ItemIndex := -1; 1297 self.cboType.Text := ''; 1298 self.memComments.Text := ''; 1299 self.txtRate.Text := ''; 1300 self.txtXDuration.text := ''; 1301 self.cboDuration.ItemIndex := -1; 1302 self.cboDuration.Text := ''; 1303 self.txtAllIVRoutes.Visible := false; 1304 self.FInitialOrderID := True; 1305 cbotypeChange(self.cboType); 1306 if self.cboroute.Items.Count > 0 then self.cboRoute.Clear; 1307 end; 538 1308 539 1309 procedure TfrmODMedIV.ClickOnGridCell; … … 608 1378 end; 609 1379 1380 procedure TfrmODMedIV.cboScheduleChange(Sender: TObject); 1381 begin 1382 inherited; 1383 if self.txtXDuration.Enabled = true then 1384 begin 1385 self.txtXDuration.Text := ''; 1386 self.cboDuration.ItemIndex := -1; 1387 end; 1388 if self.cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3)); 1389 ControlChange(sender); 1390 end; 1391 1392 procedure TfrmODMedIV.cboScheduleClick(Sender: TObject); 1393 var 1394 othSch: string; 1395 idx, i : integer; 1396 begin 1397 inherited; 1398 if cboSchedule.ItemIndex = cboSchedule.Items.IndexOf('Other') then 1399 begin 1400 othSch := CreateOtherSchedule; 1401 if length(trim(othSch)) > 1 then 1402 begin 1403 cboSchedule.Items.Add(othSch + U + U + NSSScheduleType + U + NSSAdminTime); 1404 idx := -1; 1405 for I := 0 to cboSchedule.Items.Count - 1 do 1406 if Piece(cboSchedule.Items.Strings[i], U, 1) = othSch then 1407 begin 1408 idx := i; 1409 break; 1410 end; 1411 //idx := cboSchedule.Items.IndexOfName(othSch); 1412 cboSchedule.ItemIndex := idx; 1413 end; 1414 end 1415 else 1416 begin 1417 NSSAdminTime := ''; 1418 NSSScheduleType := ''; 1419 end; 1420 end; 1421 1422 procedure TfrmODMedIV.cboScheduleExit(Sender: TObject); 1423 begin 1424 inherited; 1425 if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then 1426 begin 1427 infoBox('Please select a valid schedule from the list.'+ CRLF + CRLF + 1428 'If you would like to create a Day-of-Week schedule please select ''OTHER'' from the list.', 1429 'Incorrect Schedule.', MB_OK); 1430 cboSchedule.Text := ''; 1431 cboSchedule.SetFocus; 1432 end; 1433 end; 1434 610 1435 procedure TfrmODMedIV.cboSelectedChange(Sender: TObject); // combo editor for grid 611 1436 begin … … 632 1457 procedure TfrmODMedIV.cmdRemoveClick(Sender: TObject); // remove button for grid 633 1458 var 634 i : Integer;1459 i, stRow, stRowCount: Integer; 635 1460 begin 636 1461 inherited; … … 638 1463 begin 639 1464 if Row < 0 then Exit; 1465 stRow := Row; 1466 stRowCount := RowCount; 640 1467 if Objects[0, Row] <> nil then TIVComponent(Objects[0, Row]).Free; 641 1468 for i := Row to RowCount - 2 do Rows[i] := Rows[i + 1]; … … 643 1470 RowCount := RowCount - 1; 644 1471 end; 1472 updateRoute; 1473 if (stRowCount = 1) and (stRow = 0) then 1474 begin 1475 //self.cboRoute.ItemIndex := -1; 1476 ClearAllFields; 1477 end; 645 1478 ControlChange(Sender); 646 1479 end; … … 650 1483 procedure TfrmODMedIV.ControlChange(Sender: TObject); 651 1484 var 652 i, CurAdd, CurBase : Integer;653 x,xlimIn,xLimEx,eSch,iSch: string;1485 i, CurAdd, CurBase, idx: Integer; 1486 adminTime,x,xlimIn,xLimEx,eSch,iSch,iType, tmpdur, tmpSch, tmpRate: string; 654 1487 AnIVComponent: TIVComponent; 655 1488 FQOSchedule: TResponse; … … 666 1499 inherited; 667 1500 if Changing then Exit; 1501 loadExpectFirstDose; 668 1502 // FQOSchedule := TResponse.Create; 669 1503 FQOSchedule := Responses.FindResponseByName('SCHEDULE',1); … … 676 1510 Responses.Clear; // want this to clear even after SetupDialog in case instances don't match 677 1511 CurAdd := 1; CurBase := 1; 1512 tmpRate := ''; 678 1513 with grdSelected do for i := 0 to RowCount - 1 do 679 1514 begin … … 702 1537 if length(txtXDuration.Text) > 0 then 703 1538 begin 704 if (btnXDuration.Caption = 'L') or (btnXDuration.Caption = 'ml') then 705 begin 706 xlimEx := 'with total volume ' + txtXDuration.Text + btnXDuration.Caption; 707 xlimIn := 'with total volume ' + txtXDuration.Text + btnXDuration.Caption; 1539 tmpDur := LowerCase(cboDuration.Text); 1540 if (tmpDur = 'l') or (tmpDur = 'ml') then 1541 begin 1542 xlimEx := 'with total volume ' + txtXDuration.Text + self.cboDuration.items.strings[self.cboDuration.itemindex]; 1543 xlimIn := 'with total volume ' + txtXDuration.Text + self.cboDuration.items.strings[self.cboDuration.itemindex]; 708 1544 end 709 else if (btnXDuration.Caption = 'days') or (btnXDuration.Caption = 'hours') then 710 begin 711 xlimEx := 'for ' + txtXDuration.Text + ' ' + btnXDuration.Caption; 712 xlimIn := 'for ' + txtXDuration.Text + ' ' + btnXDuration.Caption; 713 end else 714 begin 1545 else if (tmpDur = 'days') or (tmpDur = 'hours') then 1546 begin 1547 xlimEx := 'for ' + txtXDuration.Text + ' ' + self.cboDuration.items.strings[self.cboDuration.itemindex]; 1548 xlimIn := 'for ' + txtXDuration.Text + ' ' + self.cboDuration.items.strings[self.cboDuration.itemindex]; 1549 end 1550 else if tmpDur = 'doses' then 1551 begin 1552 xlimEx := 'for a total of ' + txtXDuration.Text + ' ' + self.cboDuration.items.strings[self.cboDuration.itemindex]; 1553 xlimIn := 'for a total of ' + txtXDuration.Text + ' ' + self.cboDuration.items.strings[self.cboDuration.itemindex]; 1554 end 1555 else begin 715 1556 xlimIn := ''; 716 1557 xlimEx := ''; 717 1558 end; 718 1559 end; 719 //if x = IntToStr(StrToIntDef(x, -1)) then x := x + ' ml/hr'; 720 if IsNumericRate(x) then x := x + ' ml/hr'; 721 if (Pos('@',x)>0) and (Piece(x,'@',1) = IntToStr(StrToIntDef(Piece(x,'@',1), -1))) 722 then x := Piece(x,'@',1) + ' ml/hr@' + Copy(x, Pos('@',x) + 1, Length(x)); 723 with txtRate do if (Length(Text) > 0) then Responses.Update('RATE', 1, x, x); 1560 if cboType.Text = 'Intermittent' then iType := 'I' 1561 else iType := 'C'; 1562 Responses.Update('TYPE',1,iType,cboType.Text); 1563 Responses.Update('ROUTE',1,cboRoute.ItemID,cboRoute.Text); 1564 tmpSch := UpperCase(Trim(cboSchedule.Text)); 1565 if chkPRN.Checked then tmpSch := tmpSch + ' PRN'; 1566 if UpperCase(Copy(tmpSch, Length(tmpSch) - 6, Length(tmpSch))) = 'PRN PRN' 1567 then tmpSch := Copy(tmpSch, 1, Length(tmpSch) - 4); 1568 Responses.Update('SCHEDULE',1,tmpSch,tmpSch); 1569 (*adminTime := Piece(lblAdminTime.Caption,':',2); 1570 adminTime := Copy(adminTime,1,Length(adminTime)); 1571 if (Action in [ORDER_COPY, ORDER_EDIT]) and ((FAdminTimeDelay <> '') or (FAdminTimeClinic <> '')) and 1572 (cboSchedule.ItemIndex = FOriginalScheduleIndex) then Responses.Update('ADMIN',1,FOriginalAdminTime,FOriginalAdminTime) 1573 else Responses.Update('ADMIN',1,adminTime,adminTime);*) 1574 idx := self.cboSchedule.ItemIndex; 1575 if idx > -1 then 1576 begin 1577 adminTime := Piece(lblAdminTime.Caption,':',2); 1578 adminTime := Copy(adminTime,2,Length(adminTime)); 1579 if FAdminTimeText <> '' then AdminTime := ''; 1580 if AdminTime = 'Not Defined' then AdminTime := ''; 1581 Responses.Update('ADMIN',1,adminTime,adminTime); 1582 end; 1583 if IsNumericRate(x) then 1584 begin 1585 if cboInfusionTime.Enabled = true then 1586 begin 1587 idx := cboInfusionTime.Items.IndexOf(cboInfusionTime.Text); 1588 if idx > -1 then x := x + ' ' + cboInfusionTime.Items.Strings[idx]; 1589 tmpRate := 'Infuse Over ' + x; 1590 end 1591 else 1592 if pos('ml/hr', x)= 0 then x := x + ' ml/hr'; 1593 end; 1594 if (Pos('@',x)>0) and (Piece(x,'@',1) = IntToStr(StrToIntDef(Piece(x,'@',1), -1))) and (cboInfusionTime.Enabled = false) then 1595 begin 1596 if Pos('ml/hr', x) = 0 then 1597 x := Piece(x,'@',1) + ' ml/hr@' + Copy(x, Pos('@',x) + 1, Length(x)); 1598 end; 1599 with txtRate do if (Length(Text) > 0) then 1600 begin 1601 if tmpRate = '' then Responses.Update('RATE', 1, x, x) 1602 else Responses.Update('RATE', 1, 'INFUSE OVER ' + x, tmpRate); 1603 end; 724 1604 with cboPriority do if ItemIndex > -1 then Responses.Update('URGENCY', 1, ItemID, Text); 725 1605 if Length(xlimIn)>0 then Responses.Update('DAYS',1, xlimIn, xlimEx); 726 1606 with memComments do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text); 1607 if (chkDoseNow.Visible = True) and (chkDoseNow.Checked = True) then 1608 Responses.Update('NOW', 1, '1', 'NOW') 1609 else Responses.Update('NOW', 1, '', ''); 727 1610 memOrder.Text := Responses.OrderText; 728 if (Length(eSch)>0) or (Length(iSch)>0) then 729 Responses.Update('SCHEDULE',1,iSch,eSch); 1611 (* (Length(eSch)>0) or (Length(iSch)>0) then 1612 Responses.Update('SCHEDULE',1,iSch,eSch); *) 1613 end; 1614 1615 function TfrmODMedIV.CreateOtherRoute: string; 1616 var 1617 aRoute: string; 1618 begin 1619 aRoute := ''; 1620 Result := ''; 1621 if not ShowOtherRoutes(aRoute) then 1622 begin 1623 cboRoute.ItemIndex := -1; 1624 cboRoute.Text := ''; 1625 end 1626 else 1627 begin 1628 Result := aRoute; 1629 end; 1630 end; 1631 1632 function TfrmODMedIV.CreateOtherSchedule: string; 1633 var 1634 aSchedule: string; 1635 begin 1636 aSchedule := ''; 1637 if not ShowOtherSchedule(aSchedule) then 1638 begin 1639 cboSchedule.ItemIndex := -1; 1640 cboSchedule.Text := ''; 1641 end 1642 else 1643 begin 1644 Result := Piece(aSchedule,U,1); 1645 NSSAdminTime := Piece(aschedule,u,2); 1646 NSSScheduleType := Piece(ASchedule, U, 3); 1647 end; 730 1648 end; 731 1649 … … 748 1666 inherited SetFontSize( FontSize ); 749 1667 DoSetFontSize( FontSize ); 1668 end; 1669 1670 procedure TfrmODMedIV.DisplayDoseNow(Status: boolean); 1671 begin 1672 if self.EvtID > 0 then Status := false; 1673 if status = false then 1674 begin 1675 if (self.chkDoseNow.Visible = true) and (self.chkDoseNow.Checked = true) then self.chkDoseNow.Checked := false; 1676 self.chkDoseNow.Visible := false; 1677 end; 1678 if status = true then self.chkDoseNow.Visible := true; 750 1679 end; 751 1680 … … 782 1711 end; 783 1712 784 procedure TfrmODMedIV.btnXDurationClick(Sender: TObject);785 var786 APoint: TPoint;787 begin788 inherited;789 txtXDuration.SetFocus;790 with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));791 popDuration.Popup(APoint.X, APoint.Y);792 end;793 794 procedure TfrmODMedIV.popDurationClick(Sender: TObject);795 var796 x: string;797 begin798 inherited;799 with TMenuItem(Sender) do800 begin801 x := Caption;802 {if Length(Trim(txtXDuration.Text)) > 0 then803 if AnsiCompareStr(btnXduration.Caption,x) <> 0 then804 txtXDuration.Text := '';}805 end;806 btnXDuration.Caption := x;807 txtXDurationChange(Sender);808 ControlChange(Sender);809 end;810 811 1713 procedure TfrmODMedIV.txtXDurationChange(Sender: TObject); 812 1714 begin … … 815 1717 ControlChange(Sender); 816 1718 end; 1719 817 1720 818 1721 procedure TfrmODMedIV.pnlXDurationEnter(Sender: TObject); … … 829 1732 limitValue := ''; 830 1733 tempVal := ''; 831 if ( CharAt(aValue,1)= 'f') or ( CharAt(aValue,1)= 'F') then //days, hours 1734 if pos('dose',AValue)>0 then 1735 begin 1736 limitValue := Piece(aValue,' ',5); 1737 limitUnit := 'doses'; 1738 end; 1739 if (( CharAt(aValue,1)= 'f') or ( CharAt(aValue,1)= 'F')) and (pos('dose',aValue)=0) then //days, hours 832 1740 begin 833 1741 limitValue := Piece(aValue,' ',2); … … 842 1750 if isNumeric(CharAt(aValue,1)) then 843 1751 begin 1752 if LeftStr(avalue,1) = '0' then AValue := Copy(aValue,2,Length(aValue)); 844 1753 limitValue := FloatToStr(ExtractFloat(aValue)); 845 1754 limitUnit := Copy(aValue,length(limitValue)+1,Length(aValue)); … … 853 1762 if Trim(UpperCase(limitUnit))='CC' then 854 1763 limitUnit := 'ml'; 855 btnXDuration.Caption := limitUnit; 856 end; 857 858 end; 1764 cboduration.text := limitUnit; 1765 if cboDuration.Text <> '' then cboDuration.ItemIndex := cboDuration.Items.IndexOf(cboDuration.Text) 1766 end; 1767 1768 end; 1769 1770 procedure TfrmODMedIV.SetSchedule(const x: string); 1771 var 1772 NonPRNPart,tempSch: string; 1773 idx: integer; 1774 begin 1775 cboSchedule.ItemIndex := -1; 1776 chkPRN.Checked := False; 1777 //Check to see if schedule is already define in the schedule list 1778 idx := cboSchedule.Items.IndexOf(X); 1779 if idx > -1 then 1780 begin 1781 cboSchedule.ItemIndex := idx; 1782 exit; 1783 end; 1784 //Check to see if schedule is a Day-of-Week Schedule (MO-WE-FR@BID) 1785 if (Pos('@', x) > 0) then 1786 begin 1787 tempSch := Piece(x, '@', 2); 1788 idx := cboSchedule.Items.IndexOf(tempSch); 1789 if idx > -1 then 1790 begin 1791 //tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5); 1792 tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx]; 1793 cboSchedule.Items.Add(tempSch); 1794 cboSchedule.Text := (Piece(tempSch,U,1)); 1795 cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch,U,1)); 1796 EXIT; 1797 end; 1798 //Check to see if schedule is a Day-of-Week PRN Schedule (MO-WE-FR@BID PRN) 1799 if Pos('PRN', tempSch) > 0 then 1800 begin 1801 NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1)); 1802 idx := cboSchedule.Items.IndexOf(NonPRNPart); 1803 if idx > -1 then 1804 begin 1805 //tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5); 1806 tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx]; 1807 cboSchedule.Items.Add(tempSch); 1808 cboSchedule.Text := (Piece(tempSch,U,1)); 1809 cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch, U, 1)); 1810 chkPRN.Checked := True; 1811 EXIT; 1812 end 1813 else 1814 //Add Day-of-Week PRN schedule built off Time Prompt (MO-WE-FR@0800-1000 PRN) 1815 begin 1816 NonPRNPart := Trim(Copy(X, 1, Pos('PRN', X) - 1)); 1817 chkPRN.Checked := True; 1818 //cboSchedule.Items.Add(U + NonPRNPart + U + U + U + AdminTime); 1819 //cboSchedule.Items.Add(U + NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2)); 1820 cboSchedule.Items.Add(NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2)); 1821 cboSchedule.Text := NonPRNPart; 1822 cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(NonPRNPart); 1823 EXIT; 1824 end; 1825 end; 1826 //Add Non PRN Day-of-Week Schedule built off Time Prompt (MO-WE-FR@0800-1000) 1827 //cboSchedule.Items.Add(U + x + U + U + U + AdminTime); 1828 //cboSchedule.Items.Add(U + x + U + U + U + tempSch); 1829 cboSchedule.Items.Add(x + U + U + U + tempSch); 1830 cboSchedule.Text := x; 1831 cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(X); 1832 end 1833 else 1834 begin 1835 //Handle standard schedule mark as PRN (Q4H PRN) 1836 if Pos('PRN', X) > 0 then 1837 begin 1838 NonPRNPart := Trim(Copy(X, 1, Pos('PRN', X) - 1)); 1839 idx := cboSchedule.Items.IndexOf(NonPRNPart); 1840 if idx > -1 then 1841 begin 1842 cboSchedule.ItemIndex := idx; 1843 tempSch := cboSchedule.Items.Strings[idx]; 1844 //setPiece(tempSch,U,5,AdminTime); 1845 cboSchedule.Items.Strings[idx] := tempSch; 1846 chkPRN.Checked := True; 1847 exit; 1848 end; 1849 end; 1850 end; 1851 end; 1852 859 1853 860 1854 procedure TfrmODMedIV.txtXDurationExit(Sender: TObject); 861 1855 var 862 Len: Integer;863 1856 Code: double; 864 Digits, Warning: string; 865 begin 866 inherited; 867 if Changing then Exit; 868 //AGP Change 26.15 HIN-1203-42283 Added additional check to make sure the user can only enter the correct duration 869 Len := Length(txtXDuration.Text); 870 if (Len > 0) and (Pos('.', txtXDuration.Text)=0) then 871 begin 872 Warning := '0'; 873 Digits := '2'; 874 if ((btnXDuration.Caption = 'days') or (btnXDuration.Caption = 'hours') or (btnXDuration.Caption = 'L')) and (Len > 2) then Warning := '1'; 875 if (btnXDuration.Caption = 'ml') and (Len > 4) then Warning := '1'; 876 if Warning = '1' then 877 begin 878 if btnXduration.Caption = 'ml' then Digits := '4'; 879 ShowMessage('Invalid Value.' + #13#10 + 'Reason: Duration for ' + btnXDuration.Caption + ' cannot be greater than ' + digits + ' digits.'); 880 txtXDuration.Text := ''; 881 txtXDuration.SetFocus; 882 Exit; 883 end; 884 end; 885 if (Pos('.', txtXDuration.Text)>0) and 886 ((btnXduration.Caption = 'days') or (btnXduration.Caption = 'hours')) then 887 begin 888 ShowMessage('Can not save order.' + #13#10 889 + 'Reason: Invalid Duration, please enter an integer value for days or hours.'); 890 txtXDuration.Text := ''; 891 txtXDuration.SetFocus; 892 Exit; 893 end; 1857 begin 1858 inherited; 894 1859 if (txtXDuration.Text <> '0') and (txtXDuration.Text <> '') then 895 1860 begin … … 901 1866 if code < 0.0001 then 902 1867 begin 903 ShowM essage('Can not save order.' + #13#10 + 'Reason: Invalid Duration or Total Volume!');1868 ShowMsg('Can not save order.' + #13#10 + 'Reason: Invalid Duration or Total Volume!'); 904 1869 txtXDuration.Text := ''; 905 1870 txtXDuration.SetFocus; … … 910 1875 if (Length(txtXDuration.Text)>0) and (StrToFloat(txtXDuration.Text)<0) then 911 1876 begin 912 ShowM essage('Can not save order.' + #13#10 + 'Reason: Invalid Duration or total volume!');1877 ShowMsg('Can not save order.' + #13#10 + 'Reason: Invalid Duration or total volume!'); 913 1878 txtXDuration.Text := ''; 914 1879 txtXDuration.SetFocus; … … 921 1886 end; 922 1887 923 procedure TfrmODMedIV.txtRateExit(Sender: TObject); 924 var 925 ErrorText, LDec,RDec: string; 926 i: Integer; 927 Result: boolean; 928 begin 929 inherited; 930 //AGP Change 26.28 for CQ # 7598 add infusion rate check for valid value 931 ErrorText := 'The Infusion Rate must be in one of the following formats:' + CRLF + CRLF + 'nnnn.nn ml/hr or text@per labels per day'; 932 Result := False; 933 if pos('@',Self.txtRate.Text)>0 then exit; 934 if pos('.',Self.txtRate.Text)>0 then 935 begin 936 LDec := Piece(Self.txtRate.Text,'.',1); 937 RDec := Piece(Self.txtRate.Text,'.',2); 938 if Length(LDec)>4 then Result := True; 939 if Length(RDec)>2 then Result := True; 940 end 941 else if Length(Self.txtRate.Text)>4 then Result := True; 942 if (Result = False) and (pos('.',Self.txtRate.Text)=0) then 943 begin 944 for i := 1 to Length(Self.txtRate.Text) do if not (Self.txtRate.Text[i] in ['0'..'9']) then Result := True 945 end; 946 if Result = True then 947 begin 948 InfoBox(ErrorText,'Warning - Invalid Infusion Rate', MB_OK); 949 Self.txtRate.Text := ''; 950 Self.txtRate.SetFocus; 951 end; 1888 procedure TfrmODMedIV.UpdateDuration(SchType: string); 1889 begin 1890 if SchType = 'O' then 1891 begin 1892 self.cboDuration.ItemIndex := -1; 1893 self.txtXDuration.Text := ''; 1894 self.cboDuration.Enabled := false; 1895 self.txtXDuration.Enabled := false; 1896 self.lblLimit.Enabled := false; 1897 end 1898 else 1899 begin 1900 self.cboDuration.Enabled := true; 1901 self.txtXDuration.Enabled := true; 1902 self.lblLimit.Enabled := true; 1903 end; 1904 end; 1905 1906 procedure TfrmODMedIV.UpdateRoute; 1907 var 1908 AnIVComponent: TIVComponent; 1909 i: integer; 1910 OrderIds, TempIVRoute: TStringList; 1911 Default: boolean; 1912 begin 1913 if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True; 1914 TempIVRoute := TStringList.Create; 1915 for I := (self.cboRoute.Items.Count -1) downto 0 do 1916 begin 1917 if Piece(self.cboRoute.Items.Strings[i], U, 5) = '1' then 1918 TempIVRoute.Add(self.cboRoute.Items.Strings[i]); 1919 self.cboRoute.Items.Delete(i); 1920 end; 1921 if self.cboRoute.ItemIndex = -1 then self.cboRoute.Text := ''; 1922 OrderIds := TStringList.Create; 1923 for i := 0 to self.grdSelected.RowCount -1 do 1924 begin 1925 AniVComponent := TIVComponent(self.grdSelected.Objects[0, i]); 1926 if AnIVComponent <> nil then orderIds.Add(InttoStr(AniVComponent.IEN)); 1927 end; 1928 if OrderIds.Count > 0 then 1929 begin 1930 if (self.FInitialOrderID = True) and (self.grdSelected.RowCount = 1) then Default := True 1931 else Default := False; 1932 LoadDosageFormIVRoutes(self.cboRoute.Items, OrderIds, Default); 1933 if default = True then 1934 begin 1935 for I := 0 to cboRoute.items.Count - 1 do 1936 if Piece(cboRoute.Items.Strings[i], U, 5) = 'D' then 1937 begin 1938 cboRoute.ItemIndex := i; 1939 break; 1940 end; 1941 self.FInitialOrderID := false; 1942 end; 1943 OrderIds.Free; 1944 end; 1945 if TempIVRoute.Count > 0 then 1946 begin 1947 for I := 0 to tempIVRoute.Count - 1 do cboRoute.Items.Add(tempIVRoute.Strings[i]); 1948 TempIVRoute.Free; 1949 end; 1950 cboRoute.Items.Add(U + 'OTHER'); 1951 end; 1952 1953 1954 procedure TfrmODMedIV.txtAllIVRoutesClick(Sender: TObject); 1955 var 1956 i: integer; 1957 begin 1958 inherited; 1959 if MessageDlg('You can also select "OTHER" from the Route list' 1960 + ' to select a Route from the Expanded Med Route List.' 1961 + #13#10 + 'Click OK to launch the Expanded Med Route List.', 1962 mtInformation, [mbOK, mbCancel],0) = mrOK then 1963 begin 1964 for I := 0 to cboRoute.Items.Count - 1 do if cboRoute.Items.Strings[i] = U + 'OTHER' then break; 1965 cboRoute.ItemIndex := i; 1966 cboRouteClick(self); 1967 cboRouteChange(self.cboRoute); 1968 end; 1969 end; 1970 1971 procedure TfrmODMedIV.txtNSSClick(Sender: TObject); 1972 var 1973 i: integer; 1974 begin 1975 inherited; 1976 if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list' 1977 + ' to create a day-of-week schedule.' 1978 + #13#10 + 'Click OK to launch schedule builder', 1979 mtInformation, [mbOK, mbCancel],0) = mrOK then 1980 begin 1981 //cboSchedule.Items.Add(U + 'OTHER'); 1982 for I := 0 to cboSchedule.Items.Count - 1 do if cboSchedule.Items.Strings[i] = 'OTHER' then break; 1983 cboSchedule.ItemIndex := i; 1984 //cboSchedule.SelectByID(U+'OTHER'); 1985 cboScheduleClick(Self); 1986 cboScheduleChange(self.cboSchedule); 1987 end; 1988 end; 1989 1990 procedure TfrmODMedIV.txtRateChange(Sender: TObject); 1991 begin 1992 inherited; 1993 if Changing then Exit; 1994 ControlChange(Sender); 952 1995 end; 953 1996 -
cprs/trunk/CPRS-Chart/Orders/fODMedIn.dfm
r456 r829 74 74 ListItemsOnly = False 75 75 LongList = False 76 LookupPiece = 0 76 77 MaxLength = 0 77 78 ParentShowHint = False … … 85 86 OnExit = cboDispenseExit 86 87 OnMouseClick = cboDispenseMouseClick 88 CharsNeedMatch = 1 87 89 end 88 90 object cboMedication: TORComboBox [9] … … 100 102 ListItemsOnly = False 101 103 LongList = True 104 LookupPiece = 0 102 105 MaxLength = 0 103 106 Pieces = '2' … … 109 112 OnMouseClick = cboMedicationSelect 110 113 OnNeedData = cboMedicationNeedData 111 end 112 inherited memOrder: TMemo 114 CharsNeedMatch = 1 115 end 116 inherited memOrder: TCaptionMemo 113 117 TabOrder = 10 114 118 end … … 116 120 TabOrder = 8 117 121 end 118 inherited cmdQuit: TButton 119 TabOrder = 9 120 end 121 object cboRoute: TORComboBox [13] 122 object cboRoute: TORComboBox [12] 122 123 Left = 364 123 124 Top = 18 … … 133 134 ListItemsOnly = False 134 135 LongList = False 136 LookupPiece = 0 135 137 MaxLength = 0 136 138 Pieces = '2' … … 139 141 TabOrder = 4 140 142 OnChange = ControlChange 141 end 142 object cboSchedule: TORComboBox [14] 143 CharsNeedMatch = 1 144 end 145 object cboSchedule: TORComboBox [13] 143 146 Left = 442 144 147 Top = 18 … … 154 157 ListItemsOnly = False 155 158 LongList = False 159 LookupPiece = 0 156 160 MaxLength = 0 157 161 Sorted = False … … 159 163 TabOrder = 5 160 164 OnChange = ControlChange 161 end 162 object memComments: TMemo [15] 165 CharsNeedMatch = 1 166 end 167 object memComments: TMemo [14] 163 168 Left = 223 164 169 Top = 128 … … 169 174 OnChange = ControlChange 170 175 end 171 object cboPriority: TORComboBox [1 6]176 object cboPriority: TORComboBox [15] 172 177 Left = 442 173 178 Top = 128 … … 183 188 ListItemsOnly = False 184 189 LongList = False 190 LookupPiece = 0 185 191 MaxLength = 0 186 192 Pieces = '2' … … 189 195 TabOrder = 7 190 196 OnChange = ControlChange 191 end 192 object txtDosage: TCaptionEdit [17] 197 CharsNeedMatch = 1 198 end 199 object txtDosage: TCaptionEdit [16] 193 200 Left = 224 194 201 Top = 18 … … 200 207 Caption = 'Dosage' 201 208 end 209 inherited cmdQuit: TButton 210 TabOrder = 9 211 end 202 212 inherited pnlMessage: TPanel 203 213 TabOrder = 11 204 214 end 205 object cboMedAlt: TORComboBox 215 object cboMedAlt: TORComboBox [19] 206 216 Left = 6 207 217 Top = 18 … … 217 227 ListItemsOnly = False 218 228 LongList = True 229 LookupPiece = 0 219 230 MaxLength = 0 220 231 Pieces = '2' … … 227 238 OnMouseClick = cboMedicationSelect 228 239 OnNeedData = cboMedicationNeedData 240 CharsNeedMatch = 1 241 end 242 inherited amgrMain: TVA508AccessibilityManager 243 Data = ( 244 ( 245 'Component = cboDispense' 246 'Status = stsDefault') 247 ( 248 'Component = cboMedication' 249 'Status = stsDefault') 250 ( 251 'Component = cboRoute' 252 'Status = stsDefault') 253 ( 254 'Component = cboSchedule' 255 'Status = stsDefault') 256 ( 257 'Component = memComments' 258 'Status = stsDefault') 259 ( 260 'Component = cboPriority' 261 'Status = stsDefault') 262 ( 263 'Component = txtDosage' 264 'Status = stsDefault') 265 ( 266 'Component = cboMedAlt' 267 'Status = stsDefault') 268 ( 269 'Component = memOrder' 270 'Status = stsDefault') 271 ( 272 'Component = cmdAccept' 273 'Status = stsDefault') 274 ( 275 'Component = cmdQuit' 276 'Status = stsDefault') 277 ( 278 'Component = pnlMessage' 279 'Status = stsDefault') 280 ( 281 'Component = memMessage' 282 'Status = stsDefault') 283 ( 284 'Component = frmODMedIn' 285 'Status = stsDefault')) 229 286 end 230 287 end -
cprs/trunk/CPRS-Chart/Orders/fODMedIn.pas
r456 r829 8 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 9 9 fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore, 10 Menus ;10 Menus, VA508AccessibilityManager; 11 11 12 12 type -
cprs/trunk/CPRS-Chart/Orders/fODMedNVA.dfm
r456 r829 1 1 inherited frmODMedNVA: TfrmODMedNVA 2 Left = 1003 Top = 1 672 Left = 203 3 Top = 183 4 4 Width = 632 5 5 Height = 536 6 6 Caption = 'Document Herbal/OTC/Non-VA Medications' 7 7 Constraints.MinHeight = 365 8 ExplicitWidth = 632 9 ExplicitHeight = 536 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 … … 15 17 Constraints.MinWidth = 25 16 18 TabOrder = 4 17 end 18 inherited cmdAccept: TButton 19 Left = 540 20 Top = 463 21 Width = 69 22 Anchors = [akRight, akBottom] 23 TabOrder = 6 24 Visible = False 25 end 26 inherited cmdQuit: TButton 27 Left = 546 28 Top = 489 29 Width = 49 30 Anchors = [akRight, akBottom] 31 TabOrder = 7 32 end 33 inherited pnlMessage: TPanel 34 Top = 240 35 end 36 object pnlMeds: TPanel 19 ExplicitLeft = 0 20 ExplicitTop = 461 21 ExplicitWidth = 525 22 end 23 object pnlMeds: TPanel [1] 37 24 Left = 6 38 25 Top = 34 … … 64 51 end> 65 52 ColumnClick = False 53 Constraints.MaxHeight = 165 66 54 HideSelection = False 67 55 HotTrack = True … … 109 97 end 110 98 end 111 object txtMed: TEdit 99 object txtMed: TEdit [2] 112 100 Left = 5 113 101 Top = 6 … … 123 111 OnKeyUp = txtMedKeyUp 124 112 end 125 object pnlFields: TPanel 113 object pnlFields: TPanel [3] 126 114 Left = 3 127 115 Top = 30 … … 181 169 TabStop = True 182 170 Visible = False 171 OnClick = lblGuidelineClick 183 172 end 184 173 object tabDose: TTabControl … … 397 386 end 398 387 end 399 object btnSelect: TButton 388 object btnSelect: TButton [4] 400 389 Left = 539 401 390 Top = 463 … … 409 398 OnClick = btnSelectClick 410 399 end 400 inherited cmdAccept: TButton 401 Left = 540 402 Top = 463 403 Width = 69 404 Anchors = [akRight, akBottom] 405 TabOrder = 6 406 Visible = False 407 ExplicitLeft = 540 408 ExplicitTop = 463 409 ExplicitWidth = 69 410 end 411 inherited cmdQuit: TButton 412 Left = 546 413 Top = 489 414 Width = 49 415 Anchors = [akRight, akBottom] 416 TabOrder = 7 417 ExplicitLeft = 546 418 ExplicitTop = 489 419 ExplicitWidth = 49 420 end 421 inherited pnlMessage: TPanel 422 Top = 240 423 ExplicitTop = 240 424 end 425 inherited amgrMain: TVA508AccessibilityManager 426 Data = ( 427 ( 428 'Component = pnlMeds' 429 'Status = stsDefault') 430 ( 431 'Component = lstQuick' 432 'Status = stsDefault') 433 ( 434 'Component = lstAll' 435 'Status = stsDefault') 436 ( 437 'Component = txtMed' 438 'Status = stsDefault') 439 ( 440 'Component = pnlFields' 441 'Status = stsDefault') 442 ( 443 'Component = pnlTop' 444 'Status = stsDefault') 445 ( 446 'Component = lblGuideline' 447 'Status = stsDefault') 448 ( 449 'Component = tabDose' 450 'Status = stsDefault') 451 ( 452 'Component = cboDosage' 453 'Status = stsDefault') 454 ( 455 'Component = cboRoute' 456 'Status = stsDefault') 457 ( 458 'Component = cboSchedule' 459 'Status = stsDefault') 460 ( 461 'Component = chkPRN' 462 'Status = stsDefault') 463 ( 464 'Component = pnlBottom' 465 'Status = stsDefault') 466 ( 467 'Component = memComment' 468 'Status = stsDefault') 469 ( 470 'Component = lblAdminTime' 471 'Status = stsDefault') 472 ( 473 'Component = calStart' 474 'Status = stsDefault') 475 ( 476 'Component = lbStatements' 477 'Status = stsDefault') 478 ( 479 'Component = memDrugMsg' 480 'Status = stsDefault') 481 ( 482 'Component = btnSelect' 483 'Status = stsDefault') 484 ( 485 'Component = memOrder' 486 'Status = stsDefault') 487 ( 488 'Component = cmdAccept' 489 'Status = stsDefault') 490 ( 491 'Component = cmdQuit' 492 'Status = stsDefault') 493 ( 494 'Component = pnlMessage' 495 'Status = stsDefault') 496 ( 497 'Component = memMessage' 498 'Status = stsDefault') 499 ( 500 'Component = frmODMedNVA' 501 'Status = stsDefault')) 502 end 411 503 object dlgStart: TORDateTimeDlg 412 FMDateTime = 3001101 504 FMDateTime = 3001101.000000000000000000 413 505 DateOnly = False 414 506 RequireTime = True -
cprs/trunk/CPRS-Chart/Orders/fODMedNVA.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm, 8 Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn; 8 Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn, contnrs, 9 VA508AccessibilityManager; 9 10 10 11 const … … 94 95 private 95 96 {selection} 96 FAllItems: TStringList; 97 FAllFirst: Integer; 98 FAllLast: Integer; 99 FAllList: Integer; 97 FNVAMedCache: TObjectList; 98 FCacheIEN: integer; 100 99 FQuickList: Integer; 101 100 FQuickItems: TStringList; … … 135 134 FQOInitial: boolean; 136 135 FRemoveText : Boolean; 136 FMedName: string; 137 137 {selection} 138 138 procedure ChangeDelayed; … … 140 140 function FindQuickOrder(const x: string): Integer; 141 141 function isUniqueQuickOrder(iText: string): Boolean; 142 function GetCacheChunkIndex(idx: integer): integer; 142 143 procedure ScrollToVisible(AListView: TListView); 143 144 procedure StartKeyTimer; … … 180 181 procedure SetupDialog(OrderAction: Integer; const ID: string); override; 181 182 procedure CheckDecimal(var AStr: string); 183 property MedName: string read FMedName write FMedName; 182 184 end; 183 185 … … 194 196 195 197 uses rCore, uCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA, 196 uAccessibleStringGrid, fFrame, ORNet;198 fFrame, ORNet, VAUtils; 197 199 198 200 const … … 259 261 TIMER_FROM_DAYS = 1; 260 262 TIMER_FROM_QTY = 2; 263 264 MED_CACHE_CHUNK_SIZE = 100; 261 265 {text constants} 262 266 TX_ADMIN = 'Requested Start: '; … … 346 350 FRowHeight := MainFontHeight + 1; 347 351 x := 'NV RX'; // CLA 6/3/03 348 ListForOrderable(F AllList, ListCount, x);352 ListForOrderable(FCacheIEN, ListCount, x); 349 353 lstAll.Items.Count := ListCount; 350 FAllItems := TStringList.Create; 351 FAllFirst := -1; 352 FAllLast := -1; 354 FNVAMedCache := TObjectList.Create; 353 355 FQuickItems := TStringList.Create; 354 356 ListForQuickOrders(FQuickList, ListCount, x); … … 370 372 then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6; 371 373 pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top; 374 cmdAccept.Left := cmdQuit.Left; 375 cmdaccept.Anchors := cmdQuit.anchors; 372 376 FNoZero := False; 373 377 FShrinked := False; … … 382 386 {selection} 383 387 FQuickItems.Free; 384 F AllItems.Free;388 FNVAMedCache.Free; 385 389 {edit} 386 390 FGuideline.Free; … … 553 557 end; 554 558 end; 559 if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".'); 555 560 end; 556 561 … … 659 664 UserText := Copy(txtMed.Text, 1, txtMed.SelStart); 660 665 QuickIndex := FindQuickOrder(UserText); 661 AllIndex := IndexOfOrderable(F AllList, UserText); // but always synch the full list666 AllIndex := IndexOfOrderable(FCacheIEN, UserText); // but always synch the full list 662 667 if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit; // if typing during lookup 663 668 if AllIndex > -1 then … … 772 777 { lstAll Methods (lstAll is TListView) } 773 778 779 // Cache is a list of 100 string lists, starting at idx 0 774 780 procedure TfrmODMedNVA.LoadNonVAMedCache(First, Last: Integer); 775 const 776 MAX_CACHE_ITEMS = 1000; 777 begin 778 // if range is within cache range we don't need to update anything 779 if (First >= FAllFirst) and (Last <= FAllLast) then Exit; 780 // if range is outside of cache or a superset of cache, start over 781 if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or 782 ((First < FAllFirst) and (Last > FAllLast)) or 783 (FAllItems.Count > MAX_CACHE_ITEMS) then 784 begin 785 FAllItems.Clear; 786 FAllFirst := -1; 787 FAllLast := -1; 788 end; 789 // if getting items immediately before cache range 790 if (First < FAllFirst) and (Last >= FAllFirst) then Last := Pred(FAllFirst); 791 // if getting items immediately after cache range 792 if (Last > FAllLast) and (First <= FAllLast) then First := Succ(FAllLast); 793 // retrieve the items and append (First>FAllLast) or prepend them to FAllItems 794 SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last); 795 // reset FAllFirst & FAllLast indexes to reflect current FAllItems 796 if FAllFirst < 0 then FAllFirst := First; 797 if FAllLast < 0 then FAllLast := Last; 798 if First < FAllFirst then FAllFirst := First; 799 if Last > FAllLast then FAllLast := Last; 781 var 782 firstChunk, lastchunk, i: integer; 783 list: TStringList; 784 firstMed, LastMed: integer; 785 786 begin 787 firstChunk := GetCacheChunkIndex(First); 788 lastChunk := GetCacheChunkIndex(Last); 789 for i := firstChunk to lastChunk do 790 begin 791 if (FNVAMedCache.Count <= i) or (not assigned(FNVAMedCache[i])) then 792 begin 793 while FNVAMedCache.Count <= i do 794 FNVAMedCache.add(nil); 795 list := TStringList.Create; 796 FNVAMedCache[i] := list; 797 firstMed := i * MED_CACHE_CHUNK_SIZE; 798 LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1; 799 if LastMed >= lstAll.Items.Count then 800 LastMed := lstAll.Items.Count - 1; 801 SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed); 802 end; 803 end; 800 804 end; 801 805 … … 803 807 var 804 808 x: string; 805 begin 806 if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast) 807 then LoadNonVAMedCache(Item.Index, Item.Index); 808 x := FAllItems[Item.Index - FAllFirst]; 809 chunk: integer; 810 list: TStringList; 811 begin 812 LoadNonVAMedCache(Item.Index, Item.Index); 813 chunk := GetCacheChunkIndex(Item.Index); 814 list := TStringList(FNVAMedCache[chunk]); 815 x := list[Item.Index mod MED_CACHE_CHUNK_SIZE]; 809 816 Item.Caption := Piece(x, U, 2); 810 817 Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0)); … … 822 829 var 823 830 MedIEN: Integer; 824 MedName: string;831 //MedName: string; 825 832 QOQuantityStr: string; 826 ErrMsg : string;833 ErrMsg, temp: string; 827 834 begin 828 835 inherited; 829 836 QOQuantityStr := ''; 830 btnSelect.SetFocus; // let the exit events finish 837 btnSelect.SetFocus; 838 self.MedName := ''; // let the exit events finish 831 839 if pnlMeds.Visible then // display the medication fields 832 840 begin … … 845 853 //btnSelect.Visible := False; 846 854 btnSelect.Enabled := False; 847 ShowM essage(ErrMsg);855 ShowMsg(ErrMsg); 848 856 Exit; 849 857 end; … … 862 870 begin 863 871 MedIEN := Integer(lstAll.Selected.Data); 864 MedName := lstAll.Selected.Caption;872 self.MedName := lstAll.Selected.Caption; 865 873 txtMed.Tag := MedIEN; 866 874 ErrMsg := ''; … … 869 877 begin 870 878 btnSelect.Enabled := False; 871 ShowM essage(ErrMsg);879 ShowMsg(ErrMsg); 872 880 Exit; 873 881 end; … … 882 890 begin 883 891 txtMed.Tag := MedIEN; 884 txtMed.Text := MedName; 892 temp := self.MedName; 893 self.MedName := txtMed.Text; 894 txtMed.Text := Temp; 885 895 end; 886 896 SetOnMedSelect; … … 918 928 var 919 929 i,j: Integer; 920 x: string;930 temp,x: string; 921 931 QOPiUnChk: boolean; 922 932 PKIEnviron: boolean; … … 933 943 // set up lists & initial values based on orderable item 934 944 SetControl(txtMed, 'Medication'); 945 if (self.MedName <> '') then 946 begin 947 if (txtMed.Text <> self.MedName) then 948 begin 949 temp := self.MedName; 950 self.MedName := txtMed.Text; 951 txtMed.Text := temp; 952 end 953 else MedName := ''; 954 end; 935 955 SetControl(cboDosage, 'Dosage'); 936 956 SetControl(cboRoute, 'Route'); … … 1044 1064 else 1045 1065 SetDosage(IValueFor('INSTR', 1)); 1046 SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776 1047 SetSchedule(IValueFor('SCHEDULE', 1)); 1066 SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776 1067 SetControl(cboRoute, 'ROUTE', 1); //AGP ADDED ROUTE FOR CQ 11252 1068 SetSchedule(IValueFor('SCHEDULE', 1)); 1048 1069 if (cboSchedule.Text = '') and FIsQuickOrder then 1049 1070 begin … … 1613 1634 FUpdated := FALSE; 1614 1635 Responses.Clear; 1615 Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), txtMed.Text); 1636 if self.MedName = '' then Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), txtMed.Text) 1637 else Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), self.MedName); 1616 1638 DoseList := TStringList.Create; 1617 1639 case tabDose.TabIndex of … … 1729 1751 Schedule <TAB> (nothing) 1730 1752 Duration <TAB> Duration^Units } 1753 1754 // the following functions were created to get rid of a compile warning saying the 1755 // return value may be undefined - too much branching logic in the case statements 1756 // for the compiler to handle 1757 1758 function GetSchedule: string; 1759 begin 1760 Result := UpperCase(cboSchedule.Text); 1761 if chkPRN.Checked then Result := Result + ' PRN'; 1762 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' 1763 then Result := Copy(Result, 1, Length(Result) - 4); 1764 end; 1765 1766 function GetScheduleEX: string; 1767 begin 1768 Result := ''; 1769 with cboSchedule do 1770 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2); 1771 if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED'; 1772 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' 1773 then Result := Copy(Result, 1, Length(Result) - 10); 1774 end; 1775 1731 1776 begin 1732 1777 Result := ''; … … 1763 1808 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4); 1764 1809 FLD_SCHEDULE : begin 1765 Result := UpperCase(cboSchedule.Text); 1766 if chkPRN.Checked then Result := Result + ' PRN'; 1767 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' 1768 then Result := Copy(Result, 1, Length(Result) - 4); 1810 Result := GetSchedule; 1769 1811 end; 1770 1812 FLD_SCHED_EX : begin 1771 with cboSchedule do 1772 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2); 1773 if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED'; 1774 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' 1775 then Result := Copy(Result, 1, Length(Result) - 10); 1813 Result := GetScheduleEX; 1776 1814 end; 1777 1815 FLD_SCHED_TYP : with cboSchedule do … … 2184 2222 end; 2185 2223 2224 function TfrmODMedNVA.GetCacheChunkIndex(idx: integer): integer; 2225 begin 2226 Result := idx div MED_CACHE_CHUNK_SIZE; 2227 end; 2228 2186 2229 procedure TfrmODMedNVA.lstQuickData(Sender: TObject; Item: TListItem); 2187 2230 var … … 2209 2252 tmplst.Strings[i] := Piece(s,U,2); 2210 2253 end; 2211 Dest.Assign(tmplst);2254 FastAssign(tmplst, Dest); 2212 2255 end; 2213 2256 end; -
cprs/trunk/CPRS-Chart/Orders/fODMedOIFA.dfm
r456 r829 1 objectfrmODMedOIFA: TfrmODMedOIFA1 inherited frmODMedOIFA: TfrmODMedOIFA 2 2 Left = 0 3 3 Top = 0 4 Width = 3135 Height = 2056 4 Caption = 'Formulary Alternatives' 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 = [] 5 ClientHeight = 178 6 ClientWidth = 305 13 7 FormStyle = fsStayOnTop 14 8 OldCreateOrder = True … … 19 13 PixelsPerInch = 96 20 14 TextHeight = 13 21 object Label1: TLabel 15 object Label1: TLabel [0] 22 16 Left = 0 23 17 Top = 0 … … 26 20 Align = alTop 27 21 Caption = 'The selected drug is not in the formulary. Alternatives are:' 22 ExplicitWidth = 273 28 23 end 29 object Label2: TStaticText 24 object Label2: TStaticText [1] 30 25 Left = 0 31 26 Top = 134 … … 35 30 Caption = 'Do you wish to use the selected alternative instead?' 36 31 TabOrder = 1 32 ExplicitWidth = 250 37 33 end 38 object lstFormAlt: TORListBox 34 object lstFormAlt: TORListBox [2] 39 35 Left = 0 40 36 Top = 13 … … 52 48 Pieces = '2' 53 49 end 54 object btnPanel: TPanel 50 object btnPanel: TPanel [3] 55 51 Left = 0 56 52 Top = 151 … … 82 78 end 83 79 end 80 inherited amgrMain: TVA508AccessibilityManager 81 Data = ( 82 ( 83 'Component = Label2' 84 'Status = stsDefault') 85 ( 86 'Component = lstFormAlt' 87 'Status = stsDefault') 88 ( 89 'Component = btnPanel' 90 'Status = stsDefault') 91 ( 92 'Component = cmdYes' 93 'Status = stsDefault') 94 ( 95 'Component = cmdNo' 96 'Status = stsDefault') 97 ( 98 'Component = frmODMedOIFA' 99 'Status = stsDefault')) 100 end 84 101 end -
cprs/trunk/CPRS-Chart/Orders/fODMedOIFA.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORCtrls, ExtCtrls, fAutoSz ;7 StdCtrls, ORCtrls, ExtCtrls, fAutoSz, fBase508Form, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmODMedOIFA = class(T Form)10 TfrmODMedOIFA = class(TfrmBase508Form) 11 11 Label1: TLabel; 12 12 lstFormAlt: TORListBox; … … 57 57 with frmODMedOIFA do 58 58 begin 59 lstFormAlt.Items.Assign(FormAltList);59 FastAssign(FormAltList, lstFormAlt.Items); 60 60 ShowModal; 61 61 if Length(FSelected) > 0 then … … 91 91 with frmODMedOIFA do 92 92 begin 93 lstFormAlt.Items.Assign(FormAltList);93 FastAssign(FormAltList, lstFormAlt.Items); 94 94 ShowModal; 95 95 if Length(FSelected) > 0 then -
cprs/trunk/CPRS-Chart/Orders/fODMedOut.dfm
r456 r829 4 4 Height = 316 5 5 Caption = 'Outpatient Medication Order' 6 ExplicitHeight = 316 6 7 PixelsPerInch = 96 7 8 TextHeight = 13 … … 198 199 Top = 235 199 200 TabOrder = 15 200 end 201 inherited cmdAccept: TButton 202 Top = 235 203 TabOrder = 13 204 end 205 object cboRoute: TORComboBox [20] 201 ExplicitTop = 235 202 end 203 object cboRoute: TORComboBox [19] 206 204 Left = 314 207 205 Top = 59 … … 226 224 CharsNeedMatch = 1 227 225 end 228 object cboSchedule: TORComboBox [2 1]226 object cboSchedule: TORComboBox [20] 229 227 Left = 392 230 228 Top = 59 … … 248 246 CharsNeedMatch = 1 249 247 end 250 object memComments: TMemo [2 2]248 object memComments: TMemo [21] 251 249 Left = 202 252 250 Top = 197 … … 258 256 OnEnter = memCommentsEnter 259 257 end 260 object cboPriority: TORComboBox [2 3]258 object cboPriority: TORComboBox [22] 261 259 Left = 392 262 260 Top = 156 … … 281 279 CharsNeedMatch = 1 282 280 end 283 object cboMedAlt: TORComboBox [2 4]281 object cboMedAlt: TORComboBox [23] 284 282 Left = 6 285 283 Top = 18 … … 308 306 CharsNeedMatch = 1 309 307 end 310 object cboInstructions: TORComboBox [2 5]308 object cboInstructions: TORComboBox [24] 311 309 Left = 203 312 310 Top = 59 … … 330 328 CharsNeedMatch = 1 331 329 end 332 object cboPickup: TORComboBox [2 6]330 object cboPickup: TORComboBox [25] 333 331 Left = 202 334 332 Top = 156 … … 353 351 CharsNeedMatch = 1 354 352 end 355 object cboSC: TORComboBox [2 7]353 object cboSC: TORComboBox [26] 356 354 Left = 314 357 355 Top = 156 … … 377 375 CharsNeedMatch = 1 378 376 end 379 object txtQuantity: TCaptionEdit [2 8]377 object txtQuantity: TCaptionEdit [27] 380 378 Left = 470 381 379 Top = 59 … … 387 385 Caption = 'Quantity' 388 386 end 389 object txtRefills: TCaptionEdit [2 9]387 object txtRefills: TCaptionEdit [28] 390 388 Left = 470 391 389 Top = 105 … … 397 395 Caption = 'Refills' 398 396 end 399 object spnRefills: TUpDown [ 30]397 object spnRefills: TUpDown [29] 400 398 Left = 501 401 399 Top = 105 … … 403 401 Height = 21 404 402 Associate = txtRefills 405 Min = 0406 403 Max = 11 407 Position = 0408 404 TabOrder = 8 409 Wrap = False 410 end 411 object cmdComplex: TButton [31] 405 end 406 object cmdComplex: TButton [30] 412 407 Left = 202 413 408 Top = 18 … … 418 413 OnClick = cmdComplexClick 419 414 end 415 inherited cmdAccept: TButton 416 Top = 235 417 TabOrder = 13 418 ExplicitTop = 235 419 end 420 420 inherited cmdQuit: TButton 421 421 Top = 262 422 422 TabOrder = 14 423 ExplicitTop = 262 423 424 end 424 425 inherited pnlMessage: TPanel … … 426 427 Top = 190 427 428 TabOrder = 16 429 ExplicitLeft = 6 430 ExplicitTop = 190 431 end 432 inherited amgrMain: TVA508AccessibilityManager 433 Data = ( 434 ( 435 'Component = memComplex' 436 'Status = stsDefault') 437 ( 438 'Component = txtSIG' 439 'Status = stsDefault') 440 ( 441 'Component = cboDispense' 442 'Status = stsDefault') 443 ( 444 'Component = cboMedication' 445 'Status = stsDefault') 446 ( 447 'Component = cboRoute' 448 'Status = stsDefault') 449 ( 450 'Component = cboSchedule' 451 'Status = stsDefault') 452 ( 453 'Component = memComments' 454 'Status = stsDefault') 455 ( 456 'Component = cboPriority' 457 'Status = stsDefault') 458 ( 459 'Component = cboMedAlt' 460 'Status = stsDefault') 461 ( 462 'Component = cboInstructions' 463 'Status = stsDefault') 464 ( 465 'Component = cboPickup' 466 'Status = stsDefault') 467 ( 468 'Component = cboSC' 469 'Status = stsDefault') 470 ( 471 'Component = txtQuantity' 472 'Status = stsDefault') 473 ( 474 'Component = txtRefills' 475 'Status = stsDefault') 476 ( 477 'Component = spnRefills' 478 'Status = stsDefault') 479 ( 480 'Component = cmdComplex' 481 'Status = stsDefault') 482 ( 483 'Component = memOrder' 484 'Status = stsDefault') 485 ( 486 'Component = cmdAccept' 487 'Status = stsDefault') 488 ( 489 'Component = cmdQuit' 490 'Status = stsDefault') 491 ( 492 'Component = pnlMessage' 493 'Status = stsDefault') 494 ( 495 'Component = memMessage' 496 'Status = stsDefault') 497 ( 498 'Component = frmODMedOut' 499 'Status = stsDefault')) 428 500 end 429 501 object popUnits: TPopupMenu -
cprs/trunk/CPRS-Chart/Orders/fODMedOut.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore, Mask, 8 Menus, Buttons ;8 Menus, Buttons, VA508AccessibilityManager; 9 9 10 10 type -
cprs/trunk/CPRS-Chart/Orders/fODMeds.dfm
r456 r829 1 1 inherited frmODMeds: TfrmODMeds 2 Left = 5193 Top = 2042 Left = 321 3 Top = 183 4 4 Width = 584 5 Height = 5 155 Height = 572 6 6 HorzScrollBar.Range = 558 7 7 VertScrollBar.Range = 399 8 8 Caption = 'Medication Order' 9 9 Constraints.MinHeight = 325 10 OnKeyDown = FormKeyDown11 10 OnShow = FormShow 11 ExplicitWidth = 584 12 ExplicitHeight = 572 12 13 DesignSize = ( 13 14 576 14 488)15 545) 15 16 PixelsPerInch = 96 16 17 TextHeight = 13 … … 19 20 Top = 34 20 21 Width = 580 21 Height = 4 1322 Height = 470 22 23 Anchors = [akLeft, akTop, akRight, akBottom] 23 24 BevelOuter = bvNone 24 Caption = 'pnlMeds'25 25 TabOrder = 1 26 26 object sptSelect: TSplitter … … 68 68 Top = 137 69 69 Width = 580 70 Height = 27670 Height = 333 71 71 Align = alClient 72 72 BevelInner = bvLowered … … 98 98 end 99 99 inherited memOrder: TCaptionMemo 100 Top = 448 100 Tag = 13 101 Top = 505 101 102 Width = 502 103 TabStop = True 102 104 Anchors = [akLeft, akRight, akBottom] 103 105 TabOrder = 4 106 ExplicitTop = 505 107 ExplicitWidth = 502 104 108 end 105 109 object txtMed: TEdit [2] … … 119 123 object btnSelect: TButton [3] 120 124 Left = 515 121 Top = 448125 Top = 505 122 126 Width = 72 123 127 Height = 21 … … 129 133 OnClick = btnSelectClick 130 134 end 131 inherited cmdAccept: TButton 132 Left = 514 133 Top = 448 134 Anchors = [akRight, akBottom] 135 TabOrder = 6 136 TabStop = False 137 Visible = False 138 end 139 inherited cmdQuit: TButton 140 Left = 514 141 Top = 473 142 Width = 51 143 Anchors = [akRight, akBottom] 144 TabOrder = 7 145 end 146 inherited pnlMessage: TPanel 147 Left = 36 148 Top = 156 149 OnEnter = pnlMessageEnter 150 inherited memMessage: TRichEdit 151 OnKeyDown = memMessageKeyDown 152 end 153 end 154 object pnlFields: TPanel 135 object pnlFields: TPanel [4] 155 136 Left = 6 156 137 Top = 34 157 138 Width = 580 158 Height = 4 13139 Height = 470 159 140 Anchors = [akLeft, akTop, akRight, akBottom] 160 141 BevelOuter = bvNone … … 167 148 Top = 0 168 149 Width = 580 169 Height = 1 84150 Height = 197 170 151 Align = alClient 171 152 Constraints.MinHeight = 80 … … 173 154 DesignSize = ( 174 155 580 175 1 84)156 197) 176 157 object lblRoute: TLabel 177 158 Left = 280 … … 214 195 Top = 36 215 196 Width = 580 216 Height = 1 43197 Height = 156 217 198 Anchors = [akLeft, akTop, akRight, akBottom] 218 ColCount = 6199 ColCount = 7 219 200 DefaultColWidth = 76 220 201 DefaultRowHeight = 21 … … 237 218 76 238 219 76 220 76 239 221 76) 240 222 end … … 277 259 Top = 36 278 260 Width = 279 279 Height = 1 43261 Height = 155 280 262 Anchors = [akLeft, akTop, akRight, akBottom] 281 263 Style = orcsSimple … … 307 289 Top = 36 308 290 Width = 113 309 Height = 1 43291 Height = 156 310 292 Anchors = [akTop, akRight, akBottom] 311 293 Style = orcsSimple … … 337 319 Top = 36 338 320 Width = 178 339 Height = 1 43321 Height = 156 340 322 Anchors = [akTop, akRight, akBottom] 341 323 Style = orcsSimple … … 395 377 TabOrder = 2 396 378 OnClick = btnXRemoveClick 379 end 380 object pnlXAdminTime: TPanel 381 Left = 432 382 Top = 149 383 Width = 65 384 Height = 17 385 Caption = 'pnlXAdminTime' 386 TabOrder = 9 387 Visible = False 388 OnClick = pnlXAdminTimeClick 397 389 end 398 390 end … … 521 513 Anchors = [akLeft, akTop, akBottom] 522 514 Associate = txtXDuration 523 Min = 0524 515 Max = 999 525 Position = 0526 516 TabOrder = 1 527 Wrap = False528 end529 end530 object pnlXSequence: TKeyClickPanel531 Left = 396532 Top = 122533 Width = 37534 Height = 21535 Caption = 'Then/And box'536 TabOrder = 5537 TabStop = True538 Visible = False539 OnClick = btnXSequenceClick540 OnEnter = pnlXSequenceEnter541 OnExit = pnlXSequenceExit542 object btnXSequence: TSpeedButton543 Left = 1544 Top = 1545 Width = 38546 Height = 19547 Hint = 'A duration must be defined if using "Then" as a sequence.'548 Caption = 'then'549 Glyph.Data = {550 AE000000424DAE0000000000000076000000280000000E000000070000000100551 0400000000003800000000000000000000001000000000000000000000000000552 8000008000000080800080000000800080008080000080808000C0C0C0000000553 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333554 330033333333333333003330333333733300330003333F87330030000033FFFF555 F30033333333333333003333333333333300}556 Layout = blGlyphRight557 NumGlyphs = 2558 ParentShowHint = False559 ShowHint = True560 Spacing = 1561 OnClick = btnXSequenceClick562 end563 object SpeedButton1: TSpeedButton564 Left = 16565 Top = 16566 Width = 23567 Height = 22568 517 end 569 518 end … … 626 575 object pnlBottom: TPanel 627 576 Left = 0 628 Top = 1 84577 Top = 197 629 578 Width = 580 630 Height = 2 29579 Height = 273 631 580 Align = alBottom 632 TabOrder = 6581 TabOrder = 5 633 582 DesignSize = ( 634 583 580 635 2 29)584 273) 636 585 object lblComment: TLabel 637 586 Left = 4 … … 676 625 object Image1: TImage 677 626 Left = 5 678 Top = 177627 Top = 221 679 628 Width = 31 680 629 Height = 31 681 630 Anchors = [akLeft, akBottom] 682 631 Visible = False 632 ExplicitTop = 177 683 633 end 684 634 object chkDoseNow: TCheckBox … … 688 638 Height = 21 689 639 Caption = 'Give additional dose now' 690 TabOrder = 9640 TabOrder = 8 691 641 OnClick = chkDoseNowClick 692 642 end … … 709 659 Height = 17 710 660 Caption = '>> Quantity Dispensed: Multiples of 100 <<' 711 TabOrder = 1 2661 TabOrder = 13 712 662 end 713 663 object txtSupply: TCaptionEdit … … 729 679 Height = 21 730 680 Associate = txtSupply 731 Min = 0732 Position = 0733 681 TabOrder = 2 734 Wrap = False735 682 end 736 683 object txtQuantity: TCaptionEdit … … 751 698 Width = 16 752 699 Height = 21 753 Min = -32766700 Associate = txtQuantity 754 701 Max = 32766 755 Position = 0756 702 TabOrder = 4 757 Wrap = False758 OnChangingEx = spnQuantityChangingEx759 703 end 760 704 object txtRefills: TCaptionEdit … … 766 710 TabOrder = 5 767 711 Text = '0' 768 OnChange = ControlChange712 OnChange = txtRefillsChange 769 713 OnClick = txtRefillsClick 770 714 Caption = 'Refills' … … 776 720 Height = 21 777 721 Associate = txtRefills 778 Min = 0779 722 Max = 11 780 Position = 0781 723 TabOrder = 6 782 Wrap = False783 724 end 784 725 object grpPickup: TGroupBox … … 839 780 Sorted = False 840 781 SynonymChars = '<>' 841 TabOrder = 10782 TabOrder = 9 842 783 OnChange = ControlChange 843 784 CharsNeedMatch = 1 844 end845 object chkSC: TCheckBox846 Left = 3847 Top = 106848 Width = 175849 Height = 17850 Caption = 'for Service Connected condition'851 ParentShowHint = False852 ShowHint = True853 TabOrder = 8854 OnClick = chkSCClick855 OnEnter = chkSCEnter856 end857 object lblAdminTime: TStaticText858 Left = 262859 Top = 120860 Width = 4861 Height = 4862 TabOrder = 16863 785 end 864 786 object stcPI: TStaticText … … 898 820 object memDrugMsg: TMemo 899 821 Left = 37 900 Top = 176822 Top = 220 901 823 Width = 533 902 824 Height = 51 … … 908 830 Visible = False 909 831 end 910 end 832 object lblAdminSch: TMemo 833 Left = 344 834 Top = 120 835 Width = 68 836 Height = 15 837 Anchors = [akLeft, akTop, akRight] 838 Color = clCream 839 ParentShowHint = False 840 ReadOnly = True 841 ScrollBars = ssVertical 842 ShowHint = True 843 TabOrder = 10 844 Visible = False 845 end 846 object lblAdminTime: TVA508StaticText 847 Name = 'lblAdminTime' 848 Left = 164 849 Top = 116 850 Width = 64 851 Height = 15 852 Alignment = taLeftJustify 853 Caption = 'lblAdminTime' 854 TabOrder = 11 855 TabStop = True 856 ShowAccelChar = True 857 end 858 end 859 object cboXSequence: TORComboBox 860 Left = 438 861 Top = 122 862 Width = 64 863 Height = 21 864 Style = orcsDropDown 865 AutoSelect = True 866 Caption = 'Sequence' 867 Color = clWindow 868 DropDownCount = 8 869 Items.Strings = ( 870 'and' 871 'then') 872 ItemHeight = 13 873 ItemTipColor = clWindow 874 ItemTipEnable = True 875 ListItemsOnly = False 876 LongList = False 877 LookupPiece = 0 878 MaxLength = 0 879 Sorted = False 880 SynonymChars = '<>' 881 TabOrder = 6 882 Visible = False 883 OnChange = cboXSequenceChange 884 OnEnter = cboXSequenceEnter 885 OnExit = cboXSequenceExit 886 OnKeyDown = memMessageKeyDown 887 CharsNeedMatch = 1 888 end 889 end 890 inherited cmdAccept: TButton 891 Left = 514 892 Top = 505 893 Anchors = [akRight, akBottom] 894 TabOrder = 6 895 TabStop = False 896 Visible = False 897 ExplicitLeft = 514 898 ExplicitTop = 505 899 end 900 inherited cmdQuit: TButton 901 Left = 514 902 Top = 530 903 Width = 51 904 Anchors = [akRight, akBottom] 905 TabOrder = 7 906 ExplicitLeft = 514 907 ExplicitTop = 530 908 ExplicitWidth = 51 909 end 910 inherited pnlMessage: TPanel 911 Left = 31 912 Top = 200 913 OnEnter = pnlMessageEnter 914 ExplicitLeft = 31 915 ExplicitTop = 200 916 inherited imgMessage: TImage 917 Left = 2 918 ExplicitLeft = 2 919 end 920 inherited memMessage: TRichEdit 921 OnKeyDown = memMessageKeyDown 922 end 923 end 924 inherited amgrMain: TVA508AccessibilityManager 925 Data = ( 926 ( 927 'Component = pnlMeds' 928 'Status = stsDefault') 929 ( 930 'Component = lstQuick' 931 'Text = Quick Orders' 932 'Status = stsOK') 933 ( 934 'Component = lstAll' 935 'Text = Medications' 936 'Status = stsOK') 937 ( 938 'Component = txtMed' 939 'Text = Medication' 940 'Status = stsOK') 941 ( 942 'Component = btnSelect' 943 'Status = stsDefault') 944 ( 945 'Component = pnlFields' 946 'Status = stsDefault') 947 ( 948 'Component = pnlTop' 949 'Status = stsDefault') 950 ( 951 'Component = grdDoses' 952 'Status = stsDefault') 953 ( 954 'Component = lblGuideline' 955 'Status = stsDefault') 956 ( 957 'Component = tabDose' 958 'Status = stsDefault') 959 ( 960 'Component = cboDosage' 961 'Status = stsDefault') 962 ( 963 'Component = cboRoute' 964 'Status = stsDefault') 965 ( 966 'Component = cboSchedule' 967 'Status = stsDefault') 968 ( 969 'Component = chkPRN' 970 'Status = stsDefault') 971 ( 972 'Component = btnXInsert' 973 'Status = stsDefault') 974 ( 975 'Component = btnXRemove' 976 'Status = stsDefault') 977 ( 978 'Component = pnlXAdminTime' 979 'Status = stsDefault') 980 ( 981 'Component = cboXDosage' 982 'Status = stsDefault') 983 ( 984 'Component = cboXRoute' 985 'Status = stsDefault') 986 ( 987 'Component = pnlXDuration' 988 'Status = stsDefault') 989 ( 990 'Component = pnlXDurationButton' 991 'Status = stsDefault') 992 ( 993 'Component = txtXDuration' 994 'Status = stsDefault') 995 ( 996 'Component = spnXDuration' 997 'Status = stsDefault') 998 ( 999 'Component = pnlXSchedule' 1000 'Status = stsDefault') 1001 ( 1002 'Component = cboXSchedule' 1003 'Status = stsDefault') 1004 ( 1005 'Component = chkXPRN' 1006 'Status = stsDefault') 1007 ( 1008 'Component = pnlBottom' 1009 'Status = stsDefault') 1010 ( 1011 'Component = chkDoseNow' 1012 'Status = stsDefault') 1013 ( 1014 'Component = memComment' 1015 'Status = stsDefault') 1016 ( 1017 'Component = lblQtyMsg' 1018 'Status = stsDefault') 1019 ( 1020 'Component = txtSupply' 1021 'Status = stsDefault') 1022 ( 1023 'Component = spnSupply' 1024 'Status = stsDefault') 1025 ( 1026 'Component = txtQuantity' 1027 'Status = stsDefault') 1028 ( 1029 'Component = spnQuantity' 1030 'Status = stsDefault') 1031 ( 1032 'Component = txtRefills' 1033 'Status = stsDefault') 1034 ( 1035 'Component = spnRefills' 1036 'Status = stsDefault') 1037 ( 1038 'Component = grpPickup' 1039 'Status = stsDefault') 1040 ( 1041 'Component = radPickWindow' 1042 'Status = stsDefault') 1043 ( 1044 'Component = radPickMail' 1045 'Status = stsDefault') 1046 ( 1047 'Component = radPickClinic' 1048 'Status = stsDefault') 1049 ( 1050 'Component = cboPriority' 1051 'Status = stsDefault') 1052 ( 1053 'Component = stcPI' 1054 'Status = stsDefault') 1055 ( 1056 'Component = chkPtInstruct' 1057 'Status = stsDefault') 1058 ( 1059 'Component = memPI' 1060 'Status = stsDefault') 1061 ( 1062 'Component = memDrugMsg' 1063 'Status = stsDefault') 1064 ( 1065 'Component = memOrder' 1066 'Status = stsDefault') 1067 ( 1068 'Component = cmdAccept' 1069 'Status = stsDefault') 1070 ( 1071 'Component = cmdQuit' 1072 'Status = stsDefault') 1073 ( 1074 'Component = pnlMessage' 1075 'Status = stsDefault') 1076 ( 1077 'Component = memMessage' 1078 'Status = stsDefault') 1079 ( 1080 'Component = frmODMeds' 1081 'Status = stsDefault') 1082 ( 1083 'Component = cboXSequence' 1084 'Status = stsDefault') 1085 ( 1086 'Component = lblAdminSch' 1087 'Status = stsDefault') 1088 ( 1089 'Component = lblAdminTime' 1090 'Status = stsDefault')) 911 1091 end 912 1092 object dlgStart: TORDateTimeDlg 913 FMDateTime = 3001101 1093 FMDateTime = 3001101.000000000000000000 914 1094 DateOnly = False 915 1095 RequireTime = True … … 958 1138 end 959 1139 end 960 object popXSequence: TPopupMenu961 AutoHotkeys = maManual962 Left = 448963 Top = 145964 object and1: TMenuItem965 Tag = 1966 Caption = 'and'967 OnClick = popXSequenceClick968 end969 object then1: TMenuItem970 Tag = 2971 Caption = 'then'972 OnClick = popXSequenceClick973 end974 end975 1140 end -
cprs/trunk/CPRS-Chart/Orders/fODMeds.pas
r456 r829 8 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 9 9 fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm, 10 Menus, XUDIGSIGSC_TLB ;10 Menus, XUDIGSIGSC_TLB, VA508AccessibilityManager, VAUtils, Contnrs; 11 11 12 12 const … … 26 26 cboXRoute: TORComboBox; 27 27 pnlXDuration: TPanel; 28 pnlXSequence: TKeyClickPanel;29 btnXSequence: TSpeedButton;30 28 timCheckChanges: TTimer; 31 29 popDuration: TPopupMenu; … … 34 32 hours1: TMenuItem; 35 33 minutes1: TMenuItem; 36 popXSequence: TPopupMenu;37 and1: TMenuItem;38 then1: TMenuItem;39 34 months1: TMenuItem; 40 35 weeks1: TMenuItem; … … 78 73 radPickClinic: TRadioButton; 79 74 cboPriority: TORComboBox; 80 chkSC: TCheckBox;81 lblAdminTime: TStaticText;82 75 stcPI: TStaticText; 83 76 chkPtInstruct: TCheckBox; … … 86 79 memDrugMsg: TMemo; 87 80 txtNSS: TLabel; 88 SpeedButton1: TSpeedButton; 81 pnlXAdminTime: TPanel; 82 cboXSequence: TORComboBox; 83 lblAdminSch: TMemo; 84 lblAdminTime: TVA508StaticText; 89 85 procedure FormCreate(Sender: TObject); 90 86 procedure btnSelectClick(Sender: TObject); … … 138 134 procedure cboXRouteChange(Sender: TObject); 139 135 procedure cboXScheduleChange(Sender: TObject); 140 procedure pnlXSequenceExit(Sender: TObject);141 procedure btnXSequenceClick(Sender: TObject);142 136 procedure grdDosesExit(Sender: TObject); 143 137 procedure ListViewEnter(Sender: TObject); 144 138 procedure timCheckChangesTimer(Sender: TObject); 145 139 procedure popDurationClick(Sender: TObject); 146 procedure popXSequenceClick(Sender: TObject);147 procedure chkSCEnter(Sender: TObject);148 procedure chkSCClick(Sender: TObject);149 140 procedure cmdAcceptClick(Sender: TObject); 150 141 procedure btnXInsertClick(Sender: TObject); … … 167 158 Shift: TShiftState); 168 159 procedure cboXRouteEnter(Sender: TObject); 169 procedure pnlXSequenceEnter(Sender: TObject);170 160 procedure pnlMessageEnter(Sender: TObject); 171 161 procedure pnlMessageExit(Sender: TObject); … … 174 164 procedure memPIClick(Sender: TObject); 175 165 procedure FormResize(Sender: TObject); 176 procedure spnQuantityChangingEx(Sender: TObject;177 var AllowChange: Boolean; NewValue: Smallint;178 Direction: TUpDownDirection);179 166 procedure memPIKeyDown(Sender: TObject; var Key: Word; 180 167 Shift: TShiftState); … … 196 183 procedure WMClose(var Msg : TWMClose); message WM_CLOSE; 197 184 procedure cboXScheduleEnter(Sender: TObject); 185 procedure pnlXAdminTimeClick(Sender: TObject); 186 procedure cboXSequenceChange(Sender: TObject); 187 procedure cboXSequence1Exit(Sender: TObject); 188 procedure cboXSequenceExit(Sender: TObject); 189 procedure cboXSequenceEnter(Sender: TObject); 190 procedure txtRefillsChange(Sender: TObject); 198 191 //procedure btnNSSClick(Sender: TObject); 199 192 private 193 FCloseCalled : Boolean; 200 194 FScheduleChanged : Boolean; 201 195 {selection} 202 FAllItems: TStringList; 203 FAllFirst: Integer; 204 FAllLast: Integer; 205 FAllList: Integer; 196 FMedCache: TObjectList; 197 FCacheIEN: Integer; 206 198 FQuickList: Integer; 207 199 FQuickItems: TStringList; … … 237 229 FNoZERO: boolean; 238 230 FIsQuickOrder: boolean; 239 FAdminTimeLbl: string;240 231 FDisabledDefaultButton: TButton; 241 232 FDisabledCancelButton: TButton; … … 250 241 FRemoveText : Boolean; 251 242 FSmplPRNChkd: Boolean; 243 {Admin Time} 244 FAdminTimeLbl: string; 245 FMedName: String; 246 FNSSAdminTime: string; 247 FNSSScheduleType: string; 248 FAdminTimeText: string; 249 //FOriginalAdminTime: string; 250 //FOriginalScheduleIndex: integer; 251 FOrderAction: integer; 252 JAWSON: boolean; 252 253 procedure ChangeDelayed; 253 254 function FindQuickOrder(const x: string): Integer; 254 255 function isUniqueQuickOrder(iText: string): Boolean; 256 function GetCacheChunkIndex(idx: integer): integer; 255 257 procedure LoadMedCache(First, Last: Integer); 256 258 procedure ScrollToVisible(AListView: TListView); … … 284 286 procedure UpdateRelated(DelayUpdate: Boolean = TRUE); 285 287 procedure UpdateRefills(const CurDispDrug: string; CurSupply: Integer); 286 procedure UpdateSC(const CurDispDrug: string);287 288 procedure UpdateStartExpires(const CurSchedule: string); 288 289 procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; … … 313 314 function IsSupplyAndOutPatient : boolean; 314 315 function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer; 316 procedure DisplayDoseNow(Status: boolean); 317 function lblAdminSchGetText: string; 318 procedure lblAdminSchSetText(str: string); 315 319 protected 320 procedure Loaded; override; 316 321 procedure InitDialog; override; 317 322 procedure Validate(var AnErrMsg: string); override; 323 procedure updateSig; override; 318 324 public 319 325 ARow1: integer; 320 326 procedure SetupDialog(OrderAction: Integer; const ID: string); override; 321 327 procedure CheckDecimal(var AStr: string); 328 property MedName: string read FMedName write FMedName; 329 property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime; 330 property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType; 322 331 end; 323 332 … … 331 340 332 341 uses rCore, uCore, ORFn, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA, 333 u AccessibleStringGrid, uOrders, fOtherSchedule, StrUtils, fFrame;342 uOrders, fOtherSchedule, StrUtils, fFrame, VA508AccessibilityRouter; 334 343 335 344 const 336 345 {grid columns for complex dosing} 337 COL_SELECT = 0; 338 COL_DOSAGE = 1; 339 COL_ROUTE = 2; 340 COL_SCHEDULE = 3; 341 COL_DURATION = 4; 342 COL_SEQUENCE = 5; 343 COL_CHKXPRN = 6; 344 VAL_DOSAGE = 10; 345 VAL_ROUTE = 20; 346 VAL_SCHEDULE = 30; 347 VAL_DURATION = 40; 348 VAL_SEQUENCE = 50; 349 VAL_CHKXPRN = 60; 350 TAB = #9; 346 COL_SELECT = 0; 347 COL_DOSAGE = 1; 348 COL_ROUTE = 2; 349 COL_SCHEDULE = 3; 350 COL_DURATION = 4; 351 COL_ADMINTIME = 5; 352 COL_SEQUENCE = 6; 353 COL_CHKXPRN = 7; 354 VAL_DOSAGE = 10; 355 VAL_ROUTE = 20; 356 VAL_SCHEDULE = 30; 357 VAL_DURATION = 40; 358 VAL_ADMINTIME = 50; 359 VAL_SEQUENCE = 60; 360 VAL_CHKXPRN = 70; 361 TAB = #9; 351 362 {field identifiers} 352 363 FLD_LOCALDOSE = 1; … … 395 406 TIMER_FROM_DAYS = 1; 396 407 TIMER_FROM_QTY = 2; 408 409 MED_CACHE_CHUNK_SIZE = 100; 397 410 {text constants} 398 411 TX_ADMIN = 'Requested Start: '; … … 440 453 AutoSizeDisabled := True; 441 454 inherited; 455 FAdminTimeText := ''; 442 456 btnXDuration.Align := alClient; 443 457 AllowQuickOrder := True; … … 475 489 //if (Self.EvtID > 0) then LoadSchedules(cboSchedule.Items) 476 490 //else LoadSchedules(cboSchedule.Items, FInptDlg); 477 LoadSchedules(cboSchedule.Items, FInptDlg); 491 LoadSchedules(cboSchedule.Items, FInptDlg); 478 492 StatusText(''); 479 493 if FInptDlg then SetControlsInpatient else SetControlsOutpatient; … … 482 496 FOrigiMsgDisp := FSuppressMsg; 483 497 InitDialog; 498 isIMO := IfisIMODialog; 499 if (isIMO) or ((FInptDlg) and (encounter.Location <> patient.Location)) then 500 FAdminTimeText := 'Not defined for Clinic Locations'; 484 501 if FInptDlg then 485 502 begin … … 489 506 end; 490 507 with grdDoses do 491 begin 508 begin 492 509 ColWidths[0] := 8; // select 493 510 ColWidths[1] := 160; // dosage … … 495 512 ColWidths[3] := 102; // schedule 496 513 ColWidths[4] := 70; // duration 497 ColWidths[5] := 58; // and/then 514 if (FInptDlg) and (FAdminTimeText <> 'Not defined for Clinic Locations') then 515 begin 516 ColWidths[5] := 102; // administration times 517 ColWidths[6] := 58; // and/then 518 end 519 else 520 ColWidths[5] := 0; 521 ColWidths[6] := 58; 498 522 Cells[1, 0] := 'Dosage'; 499 523 Cells[2, 0] := 'Route'; 500 524 Cells[3, 0] := 'Schedule'; 501 525 Cells[4, 0] := 'Duration (optional)'; 502 Cells[5, 0] := ' then/and';503 end;504 TAccessibleStringGrid.WrapControl(grdDoses);526 Cells[5, 0] := 'Admin. Times'; 527 Cells[6, 0] := 'then/and'; 528 end; 505 529 506 530 // medication selection 507 531 FRowHeight := MainFontHeight + 1; 508 532 509 IsIMO := IfIsIMODialog; //IMO533 //IsIMO := IfIsIMODialog; //IMO 510 534 if (Self.EvtID > 0) then IsIMO := False; // event order can not be IMO order. 511 535 if FInptDlg then x := 'UD RX' … … 517 541 x := 'IVM RX'; 518 542 end; 519 ListForOrderable(FAllList, ListCount, x); 543 if self.EvtID > 0 then FAdminTimeText := 'To Be Determined'; 544 ListForOrderable(FCacheIEN, ListCount, x); 520 545 lstAll.Items.Count := ListCount; 521 FAllItems := TStringList.Create; 522 FAllFirst := -1; 523 FAllLast := -1; 546 FMedCache := TObjectList.Create; 524 547 FQuickItems := TStringList.Create; 525 548 ListForQuickOrders(FQuickList, ListCount, x); … … 546 569 FShowPnlXScheduleOk := True; 547 570 FRemoveText := True; 571 JAWSON := True; 572 if ScreenReaderActive = false then 573 begin 574 lblAdminTime.TabStop := false; 575 lblAdminSch.TabStop := false; 576 memOrder.TabStop := false; 577 JAWSON := false; 578 end; 548 579 end; 549 580 … … 552 583 {selection} 553 584 FQuickItems.Free; 554 F AllItems.Free;585 FMedCache.Free; 555 586 {edit} 556 587 FGuideline.Free; 557 588 FAllDoses.Free; 558 589 FAllDrugs.Free; 559 TAccessibleStringGrid.UnwrapControl(grdDoses);560 590 frmFrame.pnlVisit.Enabled := true; 561 591 inherited; … … 584 614 procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string); 585 615 var 586 AnInstr, OrderID, nsSch, Text : string;616 AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime: string; 587 617 ix: integer; 588 begin 589 inherited; 618 LocChange: boolean; 619 AResponse: TResponse; 620 621 begin 622 inherited; 623 FOrderAction := OrderAction; 624 if self.EvtID > 0 then DisplayDoseNow(false); 590 625 if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX'); 591 if CharAt(ID,1)='X'then626 if (CharAt(ID,1)='X') or (CharAt(ID,1)='C') then 592 627 begin 593 628 OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID)); 594 629 CheckExistingPI(OrderID, FPtInstruct); 595 630 end; 596 if OrderAction = ORDER_QUICK then 631 //AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true 632 //this is not the best approach but this should fix the problem with order edit losing the quantity value. 633 if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then 597 634 begin 598 635 FIsQuickOrder := True; … … 610 647 Changing := True; 611 648 txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0); 649 if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and 650 (uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit; 651 if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and 652 ((uOrders.ClinDisp = ClinDisp) or (uOrders.InptDisp = InptDisp)) and (PassDrugTest(txtMed.Tag, 'Q', true) = False) then Exit; 653 (* if (OrderAction = ORDER_QUICK) then 654 begin 655 tempAltIEN := GetQOAltOI; 656 if tempAltIEN > 0 then txtMed.Tag := tempAltIEN; 657 end; *) 612 658 SetOnMedSelect; // set up for this medication 613 659 SetOnQuickOrder; // insert quick order responses … … 638 684 end; 639 685 end; //nss 686 //if (FInptDlg) and (self.tabDose.TabIndex = TI_DOSE) and (OrderAction in [ORDER_COPY, ORDER_EDIT]) then 687 if (FInptDlg) and (OrderAction in [ORDER_COPY, ORDER_EDIT]) then 688 begin 689 TempOrder := Piece(id,';',1); 690 TempOrder := Copy(tempOrder, 2, Length(tempOrder)); 691 LocChange := DifferentOrderLocations(tempOrder, Patient.Location); 692 if LocChange = false then 693 begin 694 AResponse := Responses.FindResponseByName('ADMIN', 1); 695 if AResponse <> nil then AdminTime := AResponse.EValue; 696 if self.cboSchedule.ItemIndex > -1 then 697 begin 698 tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex]; 699 SetPiece(tempSchString,U,4,AdminTime); 700 self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString; 701 end; 702 if self.tabDose.TabIndex = TI_COMPLEX then 703 begin 704 if self.cboXSchedule.ItemIndex > -1 then 705 begin 706 tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex]; 707 SetPiece(tempSchString,U,4,AdminTime); 708 self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString; 709 end; 710 end; 711 AResponse := Responses.FindResponseByName('SCHTYPE', 1); 712 if AResponse <> nil then tempSchType := AResponse.EValue; 713 if self.cboSchedule.ItemIndex > -1 then 714 begin 715 if (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then 716 self.chkPRN.Checked := True 717 else 718 begin 719 tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex]; 720 SetPiece(tempSchString,U,3,tempSchType); 721 self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString; 722 end; 723 end; 724 if self.tabDose.TabIndex = TI_COMPLEX then 725 begin 726 if self.cboXSchedule.ItemIndex > -1 then 727 begin 728 if (Piece(self.cboXSchedule.Items.Strings[self.cboXSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then 729 self.chkXPRN.Checked := True 730 else 731 begin 732 tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex]; 733 SetPiece(tempSchString,U,3,tempSchType); 734 self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString; 735 end; 736 end; 737 end; 738 end; 739 if (FAdminTimeText <> 'Not defined for Clinic Locations') and (self.tabDose.TabIndex = TI_COMPLEX) then 740 lblAdminSchSetText(''); 741 if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText); 742 end; 640 743 if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or 641 (XfInToOutNow = true) then UpdateRelated(FALSE); //AGP Change744 (XfInToOutNow = true) or (FIsQuickOrder) then UpdateRelated(FALSE); //AGP Change 642 745 Changing := False; 746 if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and 747 (self.cboSchedule.ItemIndex > -1) then 748 UpdateStartExpires(Piece(self.cboSchedule.items.strings[self.cboSchedule.itemindex], U, 1)); 643 749 end; 644 750 { prevent the SIG from being part of the comments on pre-CPRS prescriptions } … … 663 769 procedure TfrmODMeds.Validate(var AnErrMsg: string); 664 770 var 665 i,ie,code: Integer; 771 i,ie,code, curSupply, tempRefills: Integer; 772 curDispDrug, tmpError, temp, x: string; 666 773 667 774 procedure SetError(const x: string); … … 736 843 if txtMed.Tag = 0 then SetError(TX_NO_MED); 737 844 if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE); 845 if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".'); 738 846 i := Responses.NextInstance('INSTR', 0); 739 847 while i > 0 do … … 757 865 i := Responses.NextInstance('INSTR', i); 758 866 end; 867 if self.tabDose.TabIndex = TI_DOSE then 868 begin 869 if (LeftStr(cboDosage.Text,1)='.') then 870 begin 871 SetError('Dosage must have a leading numeric value'); 872 Exit; 873 end; 874 end; 759 875 //AGP Change 26.45 Fix for then/and conjucntion PSI-04-069 760 if self.tabDose.TabIndex = 1then761 begin 762 for i := 2to self.grdDoses.RowCount do876 if self.tabDose.TabIndex = TI_COMPLEX then 877 begin 878 for i := 1 to self.grdDoses.RowCount do 763 879 begin 764 if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then 880 temp := ValFor(COL_DOSAGE, i); 881 if (LeftStr(temp,1) = '.') then 765 882 begin 766 SetError(TX_NO_SEQ);767 Exit;883 SetError('All dosage must have a leading numeric value'); 884 Exit; 768 885 end; 886 if (i > 1) and ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then 887 begin 888 SetError(TX_NO_SEQ); 889 Exit; 890 end; 769 891 end; 770 892 end; … … 772 894 begin 773 895 if Responses.IValueFor('PICKUP', 1) = '' then SetError(TX_NO_PICK); 774 if StrToIntDef(Responses.IValueFor('REFILLS', 1), 99) > spnRefills.Max 896 temp := Responses.IValueFor('REFILLS', 1); 897 for i := 1 to Length(temp) do if not (temp[i] in ['0'..'9']) then 898 begin 899 SetError('Refills can only be a number'); 900 Exit; 901 end; 902 tempRefills := StrToIntDef(temp, 0); 903 if (spnRefills.Max > 0) and (tempRefills > 0) then 904 begin 905 i := Responses.NextInstance('DOSE', 0); 906 while i > 0 do 907 begin 908 x := ValueOfResponse(FLD_DRUG_ID, i); 909 CurDispDrug := CurDispDrug + x + U; 910 i := Responses.NextInstance('DOSE', i); 911 end; 912 CurSupply := StrToIntDef(ValueOfResponse(FLD_SUPPLY) ,0); 913 UpdateRefills(CurDispDrug, CurSupply); 914 end; 915 if tempRefills > spnRefills.Max 775 916 then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max)); 776 917 with txtQuantity do 777 if not ValidQuantity(Responses.IValueFor('QTY', 1)) then SetError(TX_QTY_NV); 918 begin 919 if not ValidQuantity(Responses.IValueFor('QTY', 1)) then 920 SetError(TX_QTY_NV); 921 (* else 922 begin 923 Quantity := ValidateQuantityErrorMsg(StrtoIntDef(Responses.IValueFor('QTY', 1), 0)); 924 if Quantity <> '' then SetError(Quantity); 925 end; *) 926 end; 778 927 with txtSupply do 779 928 begin … … 787 936 if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) > 90) then SetError(TX_SUPPLY_LIM); 788 937 if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) < 1) then SetError(TX_SUPPLY_LIM1); 789 end; 938 //Supply := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1))); 939 //if Supply <> '' then SetError(Supply); 940 end; 941 tmpError := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)),StrtoIntDef(Responses.IValueFor('QTY', 1), 0)); 942 if tmpError <> '' then SetError(tmpError) 943 else ClearMaxData; 790 944 end; 791 945 end; … … 815 969 lblPriority.Visible := True; 816 970 cboPriority.Visible := True; 817 chkSC.Visible := False;818 971 chkDoseNow.Visible := True; 819 972 lblAdminTime.Visible := True; 973 lblAdminSch.Visible := True; 974 lblAdminSch.Hint := AdminTimeHelpText; 975 if cboXSequence.Items.IndexOf('except') > -1 then cboXSequence.Items.Delete(cboXSequence.Items.IndexOf('except')); 820 976 end; 821 977 822 978 procedure TfrmODMeds.SetControlsOutpatient; 823 var824 ExceptItem: TMenuItem;825 979 begin 826 980 FillerID := 'PSO'; … … 833 987 lblQuantity.Visible := True; 834 988 txtQuantity.Visible := True; 989 //if IsClozapineOrder = True then txtQuantity.Enabled := false; 835 990 spnQuantity.Visible := True; 836 991 lblQtyMsg.Visible := True; … … 841 996 lblPriority.Visible := True; 842 997 cboPriority.Visible := True; 843 chkSC.Visible := True;844 998 chkDoseNow.Visible := False; 845 999 lblAdminTime.Visible := False; 846 ExceptItem := TMenuItem.Create(Self); 847 ExceptItem.Caption := 'except'; 848 ExceptItem.Tag := 3; 849 ExceptItem.OnClick := popXSequenceClick; 850 popXSequence.Items.Add(ExceptItem); 1000 lblAdminSch.Visible := False; 1001 if cboXSequence.Items.IndexOf('except') = -1 then cboXSequence.Items.Add('except'); 1002 851 1003 end; 852 1004 … … 906 1058 x: string; 907 1059 begin 908 if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // navigation 1060 if txtMed.ReadOnly then // v27.50 - RV - CQ #15365 1061 begin 1062 if not (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then // navigation 1063 begin 1064 Key := 0; 1065 Exit; 1066 end; 1067 end 1068 else if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then // navigation 909 1069 begin 910 1070 FActiveMedList.Perform(WM_KEYDOWN, Key, 0); … … 931 1091 Shift: TShiftState); 932 1092 begin 933 if not (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then StartKeyTimer; 934 end; 1093 if txtMed.ReadOnly then exit; // v27.50 - RV - CQ #15365 1094 if not (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then StartKeyTimer; 1095 end; 1096 935 1097 936 1098 procedure TfrmODMeds.txtMedChange(Sender: TObject); … … 968 1130 UserText := Copy(txtMed.Text, 1, txtMed.SelStart); 969 1131 QuickIndex := FindQuickOrder(UserText); // look in quick list first 970 AllIndex := IndexOfOrderable(F AllList, UserText); // but always synch the full list1132 AllIndex := IndexOfOrderable(FCacheIEN, UserText); // but always synch the full list 971 1133 if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit; // if typing during lookup 972 1134 if AllIndex > -1 then … … 1044 1206 begin 1045 1207 StopKeyTimer; 1208 if txtMed.ReadOnly then exit; // v27.50 - RV - CQ #15365 1046 1209 if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed; 1047 1210 end; … … 1112 1275 { lstAll Methods (lstAll is TListView) } 1113 1276 1277 procedure TfrmODMeds.Loaded; 1278 begin 1279 inherited; 1280 if ScreenReaderSystemActive then 1281 tabDose.TabStop := TRUE; 1282 end; 1283 1284 // Cache is a list of 100 string lists, starting at idx 0 1114 1285 procedure TfrmODMeds.LoadMedCache(First, Last: Integer); 1115 const 1116 MAX_CACHE_ITEMS = 1000; 1117 begin 1118 // if range is within cache range we don't need to update anything 1119 if (First >= FAllFirst) and (Last <= FAllLast) then Exit; 1120 // if range is outside of cache or a superset of cache, start over 1121 if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or 1122 ((First < FAllFirst) and (Last > FAllLast)) or 1123 (FAllItems.Count > MAX_CACHE_ITEMS) then 1124 begin 1125 FAllItems.Clear; 1126 FAllFirst := -1; 1127 FAllLast := -1; 1128 end; 1129 // if getting items immediately before cache range 1130 if (First < FAllFirst) and (Last >= FAllFirst) then Last := Pred(FAllFirst); 1131 // if getting items immediately after cache range 1132 if (Last > FAllLast) and (First <= FAllLast) then First := Succ(FAllLast); 1133 // retrieve the items and append (First>FAllLast) or prepend them to FAllItems 1134 SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last); 1135 // reset FAllFirst & FAllLast indexes to reflect current FAllItems 1136 if FAllFirst < 0 then FAllFirst := First; 1137 if FAllLast < 0 then FAllLast := Last; 1138 if First < FAllFirst then FAllFirst := First; 1139 if Last > FAllLast then FAllLast := Last; 1286 var 1287 firstChunk, lastchunk, i: integer; 1288 list: TStringList; 1289 firstMed, LastMed: integer; 1290 1291 begin 1292 firstChunk := GetCacheChunkIndex(First); 1293 lastChunk := GetCacheChunkIndex(Last); 1294 for i := firstChunk to lastChunk do 1295 begin 1296 if (FMedCache.Count <= i) or (not assigned(FMedCache[i])) then 1297 begin 1298 while FMedCache.Count <= i do 1299 FMedCache.add(nil); 1300 list := TStringList.Create; 1301 FMedCache[i] := list; 1302 firstMed := i * MED_CACHE_CHUNK_SIZE; 1303 LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1; 1304 if LastMed >= lstAll.Items.Count then 1305 LastMed := lstAll.Items.Count - 1; 1306 SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed); 1307 end; 1308 end; 1140 1309 end; 1141 1310 … … 1143 1312 var 1144 1313 x: string; 1145 begin 1146 if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast) 1147 then LoadMedCache(Item.Index, Item.Index); 1148 x := FAllItems[Item.Index - FAllFirst]; 1314 chunk: integer; 1315 list: TStringList; 1316 begin 1317 LoadMedCache(Item.Index, Item.Index); 1318 chunk := GetCacheChunkIndex(Item.Index); 1319 list := TStringList(FMedCache[chunk]); 1320 x := list[Item.Index mod MED_CACHE_CHUNK_SIZE]; 1149 1321 Item.Caption := Piece(x, U, 2); 1150 1322 Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0)); … … 1185 1357 var 1186 1358 MedIEN: Integer; 1187 MedName: string;1359 //MedName: string; 1188 1360 QOQuantityStr: string; 1189 ErrMsg : string;1361 ErrMsg, Temp: string; 1190 1362 begin 1191 1363 inherited; 1192 1364 QOQuantityStr := ''; 1193 1365 btnSelect.SetFocus; // let the exit events finish 1194 1366 self.MedName := ''; 1195 1367 if pnlMeds.Visible then // display the medication fields 1196 1368 begin … … 1204 1376 Responses.QuickOrder := Integer(lstQuick.Selected.Data); 1205 1377 txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0); 1378 if (not FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', false) = false) then exit; 1379 if (FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', true) = false) then exit; 1206 1380 IsActivateOI(ErrMsg, txtMed.Tag); 1207 1381 if Length(ErrMsg)>0 then … … 1209 1383 //btnSelect.Visible := False; 1210 1384 btnSelect.Enabled := False; 1211 ShowM essage(ErrMsg);1385 ShowMsg(ErrMsg); 1212 1386 Exit; 1213 1387 end; … … 1228 1402 Exit; 1229 1403 end; 1404 (* temp := self.MedName; 1405 tempIEN := txtMed.Tag; 1406 QOIEN := GetQOOrderableItem(InttoStr(Responses.QuickOrder)); 1407 if QOIEN > 0 then 1408 begin 1409 CheckFormularyOI(tempIEN, temp, FInptDlg); 1410 if tempIEN <> txtMed.Tag then 1411 begin 1412 txtMed.Tag := tempIEN; 1413 txtMed.Text := temp; 1414 end; 1415 end; *) 1416 FAltChecked := True; 1417 ; 1230 1418 SetOnMedSelect; // set up for this medication 1231 1419 SetOnQuickOrder; // insert quick order responses … … 1233 1421 QOQuantityStr := txtQuantity.Text; 1234 1422 ShowMedFields; 1423 if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false; 1235 1424 if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then 1236 1425 txtQuantity.Text := QOQuantityStr; … … 1239 1428 begin 1240 1429 MedIEN := Integer(lstAll.Selected.Data); 1241 MedName := lstAll.Selected.Caption; 1430 self.MedName := lstAll.Selected.Caption; 1431 if (not FInptDLG) and (PassDrugTest(MedIEN, 'N', false) = false) then exit; 1432 if (FInptDLG) and (PassDrugTest(MedIEN, 'N', true) = false) then exit; 1242 1433 txtMed.Tag := MedIEN; 1243 1434 ErrMsg := ''; … … 1247 1438 //btnSelect.Visible := False; 1248 1439 btnSelect.Enabled := False; 1249 ShowM essage(ErrMsg);1440 ShowMsg(ErrMsg); 1250 1441 Exit; 1251 1442 end; … … 1259 1450 Exit; 1260 1451 end; 1261 if Pos(' NF', MedName) > 0 then 1262 begin 1263 CheckFormularyOI(MedIEN, MedName, FInptDlg); 1452 if Pos(' NF', self.MedName) > 0 then 1453 begin 1454 temp := self.MedName; 1455 CheckFormularyOI(MedIEN, temp, FInptDlg); 1264 1456 FAltChecked := True; 1265 1457 end; … … 1267 1459 begin 1268 1460 txtMed.Tag := MedIEN; 1269 txtMed.Text := MedName; 1461 temp := self.MedName; 1462 self.MedName := txtMed.Text; 1463 txtMed.Text := Temp; 1270 1464 end; 1271 1465 SetOnMedSelect; … … 1352 1546 cboSchedule.ItemIndex := -1; 1353 1547 cboSchedule.Text := ''; // leave items intact 1548 if FAdminTimeText <> 'Not defined for Clinic Locations' then lblAdminSchSetText(''); 1354 1549 txtSupply.Text := ''; 1355 1550 txtSupply.Tag := 0; … … 1371 1566 var 1372 1567 i,j: Integer; 1373 x: string;1568 temp,x: string; 1374 1569 QOPiUnChk: boolean; 1375 1570 PKIEnviron: boolean; 1571 AResponse: TResponse; 1376 1572 begin 1377 1573 // clear controls? … … 1380 1576 txtQuantity.Tag := 0; 1381 1577 spnQuantity.Tag := 0; 1382 chkSC.Tag := 0; 1383 QOPiUnChk := False; 1578 QOPiUnChk := False; 1384 1579 PKIEnviron := False; 1385 1580 if GetPKISite then PKIEnviron := True; … … 1390 1585 // set up lists & initial values based on orderable item 1391 1586 SetControl(txtMed, 'Medication'); 1587 if (self.MedName <> '') then 1588 begin 1589 if (txtMed.Text <> self.MedName) then 1590 begin 1591 temp := self.MedName; 1592 self.MedName := txtMed.Text; 1593 txtMed.Text := temp; 1594 end 1595 else MedName := ''; 1596 end; 1392 1597 SetControl(cboDosage, 'Dosage'); 1393 1598 SetControl(cboRoute, 'Route'); … … 1395 1600 cboRouteChange(Self); 1396 1601 x := DefaultText('Schedule'); 1397 if x <> '' then 1602 //AGP Change 27.72 trying to centralized the schedule setting code 1603 AResponse := Responses.FindResponseByName('SCHEDULE',1); 1604 if (AResponse <> nil) and (AResponse.EValue <> '') then x := AResponse.EValue; 1605 SetSchedule(x); 1606 (* if x <> '' then 1398 1607 begin 1399 1608 cboSchedule.SelectByID(x); 1609 if cboSchedule.ItemIndex > -1 then 1610 AdminTime := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,4); 1611 if (cboSchedule.ItemIndex < 0) and (RightStr(x,3) = 'PRN') then 1612 begin 1613 self.chkPRN.Checked := true; 1614 x := Copy(x,1,(Length(x)-3)); 1615 if RightStr(X,1) = ' ' then x := Copy(x,1,(Length(x)-1)) 1616 end; 1400 1617 cboSchedule.Text := x; 1401 end; 1618 end; *) 1402 1619 if Length(ValueOf(FLD_QTYDISP))>10 then 1403 1620 begin … … 1431 1648 lblPriority.Top := memcomment.Top + memComment.Height + 1; 1432 1649 cboPriority.Top := lblPriority.Top + lblPriority.Height; 1433 lblAdminTime.Left := chkDoseNow.Left; 1434 lblAdminTime.Top := chkDoseNow.Top + chkDoseNow.Height - 1; 1650 lblAdminSch.Left := chkDoseNow.Left; 1651 lblAdminSch.Top := chkDoseNow.Top + chkDoseNow.Height - 1; 1652 lblAdminSch.Height := (MainFontHeight * 3) + 3; 1653 lblAdminSch.Width := cboPriority.Left - lblAdminSch.Left - 5; 1654 lblAdminTime.Left := lblAdminSch.Left; 1655 lblAdminTime.top := lblAdminSch.Top + lblAdminSch.Height -1; 1656 if self.tabDose.TabIndex = TI_Dose then lblAdminSchSetText('') 1657 else 1658 begin 1659 if FAdminTimeText = 'Not defined for Clinic Locations' then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText) 1660 else self.lblAdminSch.Visible := False; 1661 end; 1435 1662 end else 1436 1663 begin … … 1448 1675 end; 1449 1676 //if Length(FPtInstruct) = 0 then 1450 FPtInstruct := TextOf('PtInstr');1677 if FPtInstruct = '' then FPtInstruct := TextOf('PtInstr'); 1451 1678 for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' '; 1452 1679 FPtInstruct := TrimRight(FPtInstruct); … … 1512 1739 if FIsQuickOrder then TempSch := cboSchedule.Text; 1513 1740 SetSchedule(IValueFor('SCHEDULE', i)); 1514 if (cboSchedule.Text = '') and FIsQuickOrderthen1741 if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then 1515 1742 begin 1516 1743 cboSchedule.SelectByID(TempSch); 1517 1744 cboSchedule.Text := TempSch; 1518 1745 end; 1746 if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1; 1519 1747 x := cboSchedule.Text; 1520 1748 if chkPRN.Checked then x := x + ' PRN'; … … 1524 1752 if chkPRN.Checked = True then grdDoses.Cells[COL_CHKXPRN,i] := '1'; 1525 1753 grdDoses.Cells[COL_DURATION, i] := IValueFor('DAYS', i); 1754 if FInptDlg then 1755 begin 1756 if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i) 1757 else if cboSchedule.ItemIndex > -1 then 1758 grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4) 1759 else grdDoses.Cells[COL_ADMINTIME, i] := ''; 1760 if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined'; 1761 if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText; 1762 end; 1526 1763 if IValueFor('CONJ', i) = 'A' then x := 'AND' 1527 1764 else if IValueFor('CONJ', i) = 'T' then x := 'THEN' … … 1543 1780 SetControl(cboRoute, 'ROUTE', 1); 1544 1781 SetSchedule(IValueFor('SCHEDULE', 1)); 1545 if (cboSchedule.Text = '') and FIsQuickOrderthen1782 if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then 1546 1783 begin 1547 1784 cboSchedule.SelectByID(TempSch); 1548 1785 cboSchedule.Text := TempSch; 1549 1786 end; 1787 if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1; 1550 1788 if ((cboSchedule.Text = 'OTHER') and FIsQuickOrder) then 1551 1789 FNSSOther := True; … … 1588 1826 AResponse := Responses.FindResponseByName('PICKUP', 1); 1589 1827 if AResponse <> nil then SetPickup(AResponse.IValue); 1590 if FIsQuickOrderthen1828 if (FIsQuickOrder) and (FOrderAction = ORDER_QUICK) then 1591 1829 begin 1592 1830 if not QOHasRouteDefined(Responses.QuickOrder) then … … 1603 1841 end; 1604 1842 if ValueOf(FLD_PICKUP) = '' then SetPickup(FLastPickup); 1605 AResponse := Responses.FindResponseByName('SC', 1);1606 if AResponse <> nil then chkSC.Checked := AResponse.IValue = '1';1843 // AResponse := Responses.FindResponseByName('SC', 1); 1844 Responses.FindResponseByName('SC', 1); 1607 1845 end; {if FInptDlg..else} 1608 1846 end; {with} 1609 1847 if FInptDlg then 1610 1848 begin 1611 1849 x := ValueOfResponse(FLD_SCHEDULE, 1); … … 1704 1942 lblSchedule.Visible := True; 1705 1943 cboSchedule.Visible := True; 1944 if FInptDlg = True then lblAdminSch.Visible := True 1945 else lblAdminSch.Visible := false; 1706 1946 chkPRN.Visible := True; 1707 1947 ActiveControl := cboDosage; … … 1718 1958 begin 1719 1959 DestCombo.Items.Clear; 1720 DestCombo.Items.Assign(SrcCombo.Items);1960 FastAssign(SrcCombo.Items, DestCombo.Items); 1721 1961 DestCombo.ItemIndex := SrcCombo.ItemIndex; 1722 1962 DestCombo.Text := Piece(SrcCombo.Text, TAB, 1); … … 1739 1979 else cnt := cnt+1; 1740 1980 end; 1981 if (index = -1) and (Text <> '') then 1982 begin 1983 for I := 0 to DestCombo.Items.Count - 1 do 1984 if Piece(DestCombo.Items.Strings[i],U,1) = Text then 1985 begin 1986 DestCombo.ItemIndex := i; 1987 DestCombo.Text := Text; 1988 Exit; 1989 end; 1990 end; 1741 1991 end; 1742 1992 end; … … 1815 2065 procedure TfrmODMeds.SetSchedule(const x: string); 1816 2066 var 1817 NonPRNPart: string; 1818 begin 1819 cboSchedule.ItemIndex := -1; 1820 //AGP change CQ 10593, remove code to match the new expected first dose code 1821 //PSI-05-026 1822 (* if Pos('PRN', x) > 0 then 1823 begin 1824 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); 1825 cboSchedule.SelectByID(NonPRNPart); 1826 if cboSchedule.ItemIndex < 0 then 1827 begin 1828 if NSSchedule then 1829 begin 1830 chkPRN.Checked := False; 1831 cboSchedule.Text := ''; 1832 end else 1833 begin 1834 chkPRN.Checked := True; 1835 cboSchedule.Items.Add(NonPRNPart); 1836 cboSchedule.Text := NonPRNPart; 2067 NonPRNPart,tempSch, tempText: string; 2068 begin 2069 //AGP Change 27.72 if schedule matches why goes through and reprocess the same info? 2070 if cboSchedule.ItemIndex > -1 then 2071 begin 2072 tempText := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex], U, 1); 2073 if tempText = x then exit; 2074 if (Pos('PRN',x)>0) and (chkPRN.Checked = true) then 2075 begin 2076 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); 2077 if nonPRNPart = tempText then exit; 2078 end; 1837 2079 end; 1838 end else 1839 chkPRN.Checked := True; 1840 end else 1841 begin *) 1842 chkPRN.Checked := False; 2080 cboSchedule.ItemIndex := -1; 2081 if chkPRN.Checked = True then chkPRN.Checked := False; 1843 2082 cboSchedule.SelectByID(x); 1844 if cboSchedule.ItemIndex < 0 then 1845 begin 1846 if NSSchedule then 1847 begin 1848 cboSchedule.Text := ''; 2083 if cboSchedule.ItemIndex > -1 then exit; 2084 // if cboSchedule.ItemIndex < 0 then 2085 //begin 2086 //if NSSchedule then 2087 //begin 2088 // cboSchedule.Text := ''; 2089 //end 2090 if FInptDlg then 2091 begin 2092 if (Pos('@', x) > 0) then 2093 begin 2094 tempSch := Piece(x, '@', 2); 2095 cboSchedule.SelectByID(tempSch); 2096 if cboSchedule.ItemIndex > -1 then 2097 begin 2098 tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex]; 2099 cboSchedule.Items.Add(tempSch); 2100 cboSchedule.Text := (Piece(tempSch,U,1)); 2101 cboSchedule.SelectByID(Piece(tempSch,u,1)); 2102 EXIT; 2103 end; 2104 if Pos('PRN', tempSch) > 0 then 2105 begin 2106 NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1)); 2107 cboSchedule.SelectByID(NonPRNPart); 2108 if cboSchedule.ItemIndex > -1 then 2109 begin 2110 tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex]; 2111 cboSchedule.Items.Add(tempSch); 2112 cboSchedule.Text := (Piece(tempSch,U,1)); 2113 cboSchedule.SelectByID(Piece(tempSch,u,1)); 2114 chkPRN.Checked := True; 2115 EXIT; 2116 end 2117 else 2118 begin 2119 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); 2120 chkPRN.Checked := true; 2121 tempSch := NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2); 2122 cboSchedule.Items.Add(tempSch); 2123 cboSchedule.SelectByID(Piece(tempSch, U, 1)); 2124 EXIT; 2125 end; 2126 end; 2127 cboSchedule.Items.Add(X + U + U + U + Piece(x, '@', 2)); 2128 cboSchedule.Text := x; 2129 cboSchedule.SelectByID(x); 2130 EXIT; 2131 end 2132 else if Pos('PRN', x) > 0 then 2133 begin 2134 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); 2135 chkPRN.Checked := True; 2136 cboSchedule.SelectByID(NonPRNPart); 2137 if cboSchedule.ItemIndex > -1 then EXIT; 2138 end; 1849 2139 end 1850 else 1851 begin 1852 if Pos('PRN', x) > 0 then 2140 else if Pos('PRN', x) > 0 then 1853 2141 begin 1854 2142 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); … … 1861 2149 EXIT; 1862 2150 end; 1863 cboSchedule.Items.Add(x); 1864 cboSchedule.Text := x; 1865 cboSchedule.SelectByID(x); 1866 end; 1867 end; 2151 cboSchedule.Items.Add(x); 2152 cboSchedule.Text := x; 2153 cboSchedule.SelectByID(x); 1868 2154 end; 1869 2155 … … 1872 2158 var 1873 2159 //text,x, tmpsch: string; 1874 text, x: string;2160 text, tmpAdmin, x: string; 1875 2161 reset: integer; 1876 2162 begin … … 1896 2182 TI_DOSE: begin 1897 2183 cboXSchedule.Clear; // Added to Fix CQ: 9603 2184 cboXDosage.Clear; 1898 2185 // clean up responses? 1899 2186 FSuppressMsg := FOrigiMsgDisp; … … 1912 2199 FSuppressMsg := FOrigiMsgDisp; 1913 2200 if reset = 1 then exit; 2201 (* AGP Change admin wrap 27.73 2202 tmpAdmin := Piece(self.lblAdminSch.text, ':', 2); 2203 tmpAdmin := Copy(tmpAdmin,2,Length(tmpAdmin)); *) 2204 tmpAdmin := lblAdminSchGetText; 2205 if FAdminTimeText <> '' then 2206 begin 2207 tmpAdmin := FAdminTimeText; 2208 if FAdminTimeText <> 'Not defined for Clinic Locations' then self.lblAdminSch.Visible := False; 2209 end; 1914 2210 ShowControlsComplex; 1915 2211 ResetOnTabChange; … … 1917 2213 txtNss.Visible := False; 1918 2214 x := cboXDosage.Text + TAB; 2215 if LeftStr(x,1) = '.' then x := ''; 1919 2216 with cboXDosage do if ItemIndex > -1 then x := x + Items[ItemIndex]; 1920 2217 grdDoses.Cells[COL_DOSAGE, 1] := x; … … 1925 2222 with cboXSchedule do if ItemIndex > -1 then x := x + Items[ItemIndex]; 1926 2223 grdDoses.Cells[COL_SCHEDULE, 1] := x; 1927 UpdateStartExpires(ValFor(VAL_SCHEDULE,1)); 2224 //AGP Change 27.1 handle PRN not showing in schedule panel if a dose is not selected. 2225 if FSmplPRNChkd then 2226 begin 2227 pnlXSchedule.Tag := 1; 2228 self.chkXPRN.Checked := True; 2229 end; 2230 if FInptDLG then UpdateStartExpires(ValFor(VAL_SCHEDULE,1)); 1928 2231 ControlChange(Self); 1929 2232 end; {TI_COMPLEX} 1930 2233 end; {case} 1931 end; 1932 2234 if ScreenReaderSystemActive then 2235 GetScreenReader.Speak(tabDose.Tabs[tabDose.TabIndex] + ' tab'); 2236 end; 2237 2238 2239 function TfrmODMeds.lblAdminSchGetText: string; 2240 var 2241 tempstr: string; 2242 i: integer; 2243 begin 2244 result := ''; 2245 if self.lblAdminSch.Text = '' then exit; 2246 tempstr := ''; 2247 if self.lblAdminSch.Lines.Count > 1 then 2248 begin 2249 for i := 0 to self.lblAdminSch.Lines.Count - 1 do 2250 tempstr := tempStr + self.lblAdminSch.Lines.Strings[i]; 2251 end 2252 else if self.lblAdminSch.Lines.Count = 1 then 2253 begin 2254 tempstr := self.lblAdminSch.Text; 2255 end; 2256 Result := Piece(tempStr,':',2); 2257 Result := Copy(Result,2,Length(Result)); 2258 end; 2259 2260 procedure TfrmODMeds.lblAdminSchSetText(str: string); 2261 var 2262 cutoff: integer; 2263 begin 2264 cutoff := lblAdminSch.width div MainFontWidth; 2265 if Length(str) > cutoff then self.lblAdminSch.Text := Copy(str, 1, cutoff) + CRLF + 2266 Copy(str, cutoff + 1, Length(str)) 2267 else self.lblAdminSch.Text := str; 2268 end; 1933 2269 1934 2270 procedure TfrmODMeds.lblGuidelineClick(Sender: TObject); … … 2010 2346 2011 2347 procedure TfrmODMeds.cboDosageChange(Sender: TObject); 2012 begin 2013 inherited; 2348 var 2349 temp1,temp2: string; 2350 Count: integer; 2351 begin 2352 inherited; 2353 Count := Pos(U,cboDosage.Text); 2354 if Count > 0 then 2355 begin 2356 temp1 := copy(cboDosage.Text,0,count-1); 2357 temp2 := copy(cboDosage.Text,count+1,Length(cboDosage.text)); 2358 infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK); 2359 cboDosage.Text := temp1 + temp2; 2360 end; 2014 2361 UpdateRelated; 2015 2362 end; 2016 2363 2017 2364 procedure TfrmODMeds.cboDosageExit(Sender: TObject); 2018 begin 2019 inherited; 2365 var 2366 str: string; 2367 begin 2368 inherited; 2369 str := cboDosage.Text; 2020 2370 if (length(cboDosage.Text)<1) then 2021 cboDosage.ItemIndex := -1; 2371 cboDosage.ItemIndex := -1; 2372 (* Probably not needed here since this on validation check on accept 2373 if (LeftStr(cboDosage.Text,1)='.') then 2374 begin 2375 infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK); 2376 if self.tabDose.TabIndex = TI_DOSE then cboDosage.SetFocus; 2377 Exit; 2378 end; *) 2379 if (length(cbodosage.Text)>0) and (cboDosage.ItemIndex > -1) and 2380 (Piece(cboDosage.Items.Strings[cboDosage.ItemIndex],U,5) <> Piece(cboDosage.Text,tab,1)) then 2381 begin 2382 cboDosage.ItemIndex := -1; 2383 cboDosage.Text := Piece(str, tab, 1); 2384 UpdateRelated(false); 2385 end; 2022 2386 if ActiveControl = memMessage then 2023 2387 begin … … 2082 2446 if length(trim(othSch)) > 1 then 2083 2447 begin 2448 othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime; 2449 cboSchedule.Items.Add(othSch); 2450 idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1)); 2451 cboSchedule.ItemIndex := idx; 2452 end; 2453 end 2454 else 2455 begin 2456 NSSAdminTime := ''; 2457 FNSSScheduleType := ''; 2458 end; 2459 UpdateRelated(False); 2460 end; 2461 2462 2463 procedure TfrmODMeds.cboScheduleChange(Sender: TObject); 2464 var 2465 othSch: string; 2466 idx : integer; 2467 begin 2468 inherited; 2469 if (FInptDlg) and (cboSchedule.Text = 'OTHER') then 2470 begin 2471 othSch := CreateOtherScheduel; 2472 if length(trim(othSch)) > 1 then 2473 begin 2084 2474 cboSchedule.Items.Add(othSch); 2085 2475 idx := cboSchedule.Items.IndexOf(OthSch); … … 2087 2477 end; 2088 2478 end; 2089 UpdateRelated(False);2090 end;2091 2092 procedure TfrmODMeds.cboScheduleChange(Sender: TObject);2093 var2094 othSch: string;2095 idx : integer;2096 begin2097 inherited;2098 if (FInptDlg) and (cboSchedule.Text = 'OTHER') then2099 begin2100 othSch := CreateOtherScheduel;2101 if length(trim(othSch)) > 1 then2102 begin2103 cboSchedule.Items.Add(othSch);2104 idx := cboSchedule.Items.IndexOf(OthSch);2105 cboSchedule.ItemIndex := idx;2106 end;2107 end;2108 //Remove Deletion of Text, since we are changing the validation to be on exit of the control.2109 { if (Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0) and FInptDlg then2110 cboSchedule.Text := '';}2111 2479 FScheduleChanged := true; 2112 2480 UpdateRelated; … … 2178 2546 inherited; 2179 2547 if Changing then Exit; 2180 if not Showing then Exit; 2548 if not Showing then 2549 begin 2550 if (FISQuickOrder = true) and (txtQuantity.Text = '0') and (FLastQuantity > 0) and (FLastQuantity <> StrtoInt64(txtQuantity.text)) then 2551 begin 2552 Changing := True; 2553 txtQuantity.Text := FloattoStr(FLastQuantity); 2554 Changing := False; 2555 end; 2556 Exit; 2557 end; 2181 2558 if FNoZERO = False then FNoZERO := True; 2182 2559 // if value = 0, change probably caused by the spin button 2183 2560 if txtQuantity.Text <> '0' then txtQuantity.Tag := 1; 2184 2561 UpdateRelated; 2185 end;2186 2187 procedure TfrmODMeds.chkSCEnter(Sender: TObject);2188 begin2189 inherited;2190 pnlMessage.TabOrder := chkSC.TabOrder+1;2191 DispOrderMessage(RatedDisabilities);2192 end;2193 2194 procedure TfrmODMeds.chkSCClick(Sender: TObject);2195 begin2196 inherited;2197 chkSC.Tag := 1;2198 2562 end; 2199 2563 … … 2315 2679 end; 2316 2680 2681 2317 2682 function TfrmODMeds.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string; 2318 2683 var … … 2441 2806 begin 2442 2807 Result := ''; 2443 2808 if FInptDlg then // inpatient dialog 2444 2809 begin 2445 2810 DrugOK := True; … … 2491 2856 end 2492 2857 else DoseUnits := Piece(DoseFields, '&', 2); 2493 if not AnsiSameText(DoseUnits, DrugUnits) then DrugOK := False;2858 if (not AnsiSameText(DoseUnits, DrugUnits)) then DrugOK := False; 2494 2859 end; 2495 2860 if not DrugOK then … … 2536 2901 FUpdated := FALSE; 2537 2902 Responses.Clear; 2538 Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), txtMed.Text); 2903 if self.MedName = '' then Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), txtMed.Text) 2904 else Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), self.MedName); 2539 2905 DoseList := TStringList.Create; 2540 2906 case tabDose.TabIndex of … … 2579 2945 else Responses.Update('ROUTE', 1, '', x); 2580 2946 x := ValueOf(FLD_SCHEDULE); Responses.Update('SCHEDULE', 1, x, x); 2947 if FInptDlg then 2948 begin 2949 (* AGP Change Admin Time Wrap 27.73 2950 x := Piece(self.lblAdminSch.text,':',2); 2951 x := Copy(x,2,Length(x)); *) 2952 x := lblAdminSchGetText; 2953 if FAdminTimeText <> '' then x := ''; 2954 if x = 'Not Defined' then x := ''; 2955 Responses.Update('ADMIN',1,x,x); 2956 X := Valueof(FLD_SCHED_TYP); 2957 if self.chkPRN.Checked = true then x := 'P'; 2958 Responses.Update('SCHTYPE',1,x,x); 2959 end; 2581 2960 end; 2582 2961 TI_COMPLEX: … … 2627 3006 end; 2628 3007 x := ValueOf(FLD_DURATION, i); Responses.Update('DAYS', i, UpperCase(x), x); 3008 if FInptDlg then 3009 begin 3010 x := ValFor(VAL_ADMINTIME,i); 3011 if FAdminTimeText <> '' then x := ''; 3012 if x = 'Not Defined' then x := ''; 3013 Responses.Update('ADMIN',i,x,x); 3014 x := Valueof(FLD_SCHED_TYP, i); 3015 if ValFor(VAL_CHKXPRN, i) = '1' then x := 'P'; 3016 Responses.Update('SCHTYPE', i, x, x); 3017 end; 2629 3018 x := ValueOf(FLD_SEQUENCE, i); 2630 3019 if Uppercase(x) = 'THEN' then x := 'T' … … 2674 3063 with grdDoses do 2675 3064 case FieldID of 2676 COL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 1); 2677 COL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1); 2678 COL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 2679 COL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1); 2680 COL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1); 2681 VAL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 2); 2682 VAL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 2); 2683 VAL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 2684 VAL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1); 2685 VAL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1); 2686 VAL_CHKXPRN : Result := Cells[COL_CHKXPRN, ARow]; 3065 COL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 1); 3066 COL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1); 3067 COL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 3068 COL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1); 3069 COL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1); 3070 VAL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 2); 3071 VAL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 2); 3072 VAL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 3073 VAL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1); 3074 VAL_ADMINTIME : Result := Piece(Cells[COL_ADMINTIME, ARow], TAB, 1); 3075 VAL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1); 3076 VAL_CHKXPRN : Result := Cells[COL_CHKXPRN, ARow]; 2687 3077 end; 2688 3078 end; … … 2730 3120 function TfrmODMeds.DurationToDays: Integer; 2731 3121 var 2732 i, DoseMinutes, TotalMinutes: Integer;3122 i, DoseMinutes, AndMinutes, TotalMinutes: Integer; 2733 3123 AllRows: Boolean; 2734 3124 Days: Extended; … … 2743 3133 if not AllRows then Exit; 2744 3134 3135 AndMinutes := 0; 2745 3136 TotalMinutes := 0; 2746 3137 with grdDoses do for i := 1 to Pred(RowCount) do … … 2754 3145 if Piece(x, ' ', 2) = 'HOURS' then DoseMinutes := ExtractInteger(x) * 60; 2755 3146 if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x); 2756 TotalMinutes := TotalMinutes + DoseMinutes; 2757 end; 3147 // Determine how TotalMinutes should be calculated based on conjunction 3148 if ValFor(COL_SEQUENCE, i) <> 'AND' then // 'THEN', 'EXCEPT', or '' 3149 begin 3150 if AndMinutes = 0 then TotalMinutes := TotalMinutes + DoseMinutes; 3151 if AndMinutes > 0 then 3152 begin 3153 if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes; 3154 TotalMinutes := TotalMinutes + AndMinutes; 3155 AndMinutes := 0; 3156 end; 3157 if ValFor(COL_SEQUENCE, i) = 'EXCEPT' then break; //quit out of For Loop to stop counting TotalMinutes 3158 end; 3159 if (ValFor(COL_SEQUENCE, i) = 'AND') then 3160 if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes; 3161 end; 3162 if AndMinutes > 0 then TotalMinutes := TotalMinutes + AndMinutes; 3163 2758 3164 Days := TotalMinutes / 1440; 2759 3165 if Days > Int(Days) then Days := Days + 1; … … 2768 3174 REL_DURATION = 0.16; 2769 3175 REL_ANDTHEN = 0.10; 3176 REL_ADMINTIME = 0.16; 2770 3177 var 2771 3178 i, ht, RowCountShowing: Integer; … … 2777 3184 i := grdDoses.Width - 12; // 12 = 4 pixel margin + 8 pixel column 0 2778 3185 i := i - GetSystemMetrics(SM_CXVSCROLL); // compensate for appearance of scroll bar 2779 ColWidths[1] := Round(REL_DOSAGE * i); // dosage 2780 ColWidths[2] := Round(REL_ROUTE * i); // route 2781 ColWidths[3] := Round(REL_SCHEDULE * i); // schedule 2782 ColWidths[4] := Round(REL_DURATION * i); // duration 2783 ColWidths[5] := Round(REL_ANDTHEN * i); // and/then 3186 if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then 3187 begin 3188 ColWidths[1] := Round(REL_DOSAGE * i); // dosage 3189 ColWidths[2] := Round(REL_ROUTE * i); // route 3190 ColWidths[3] := Round(REL_SCHEDULE * i); // schedule 3191 ColWidths[4] := Round(REL_DURATION * i); // duration 3192 ColWidths[5] := Round(0 * i); // administration time 3193 grdDoses.TabStops[5] := False; 3194 ColWidths[6] := Round(REL_ANDTHEN * i); // and/then 3195 end 3196 else 3197 begin 3198 ColWidths[1] := Round(0.35 * i); // dosage 3199 ColWidths[2] := Round(0.10 * i); // route 3200 ColWidths[3] := Round(0.19 * i); // schedule 3201 ColWidths[4] := Round(0.12 * i); // duration 3202 ColWidths[5] := Round(0.16 * i); // administration time 3203 grdDoses.TabStops[5] := True; 3204 ColWidths[6] := Round(0.08 * i); // and/then 3205 end; 2784 3206 // adjust height of grid to not show partial rows 2785 3207 ht := pnlBottom.Top - Top - 6; … … 2796 3218 COL_SCHEDULE:ColControl := pnlXSchedule; 2797 3219 COL_DURATION:ColControl := pnlXDuration; 2798 COL_SEQUENCE:ColControl := pnlXSequence; 3220 COL_ADMINTIME:ColControl := pnlXAdminTime; 3221 COL_SEQUENCE:ColControl := cboXSequence; 2799 3222 end; {case} 2800 3223 … … 2844 3267 COL_ROUTE: with cboXRoute do if Items.Count > 0 then DroppedDown := True; 2845 3268 COL_SCHEDULE: with cboXSchedule do if Items.Count > 0 then DroppedDown := True; 3269 COL_SEQUENCE: with cboXSequence do if Items.Count > 0 then DroppedDown := True; 3270 2846 3271 end; 2847 3272 FDropColumn := -1; … … 2977 3402 end; *) 2978 3403 Changing := FALSE; 2979 pnlXSequence.Tag := ARow;3404 cboXSequence.Tag := ARow; 2980 3405 PlaceControl(pnlXSchedule); 2981 //cboXSchedule.SetFocus;2982 3406 FDropColumn := COL_SCHEDULE; 2983 3407 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SCHEDULE); … … 3005 3429 end; 3006 3430 COL_SEQUENCE: begin 3007 x := ValFor(COL_SEQUENCE, ARow); 3008 //if x = '' then x := 'and'; AGP Change 26.46 remove for CQ 9535 3009 btnXSequence.Caption := x; 3010 pnlXSequence.Caption := btnXSequence.Caption; 3011 pnlXSequence.Tag := ARow; 3431 SynchCombo(cboXSequence, ValFor(VAL_SEQUENCE, ARow), ValFor(COL_SEQUENCE, ARow)); 3432 cboXSequence.Tag := ARow; 3012 3433 ARow1 := ARow; 3013 PlaceControl(pnlXSequence); 3014 btnXSequence.Width := pnlXSequence.Width; 3434 PlaceControl(cboXSequence); 3435 FDropColumn := COL_SEQUENCE; 3436 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SEQUENCE); 3015 3437 end; 3438 COL_ADMINTIME: BEGIN 3439 pnlXAdminTime.OnClick(pnlXAdminTime); 3440 end; 3016 3441 end; {case ACol} 3017 3442 end; … … 3028 3453 txtXDuration.SelStart := 1; 3029 3454 end; 3455 COL_SEQUENCE : FindInCombo(Chr(Message.WParam), cboXSequence); 3030 3456 end; 3031 3457 end; … … 3041 3467 3042 3468 procedure TfrmODMeds.cboXDosageChange(Sender: TObject); 3469 var 3470 temp1,temp2: string; 3471 count: integer; 3043 3472 begin 3044 3473 inherited; 3045 3474 if not Changing and (cboXDosage.ItemIndex < 0) then 3046 3475 begin 3476 Count := Pos(U,cboXDosage.Text); 3477 if Count > 0 then 3478 begin 3479 temp1 := copy(cboXDosage.Text,0,count-1); 3480 temp2 := copy(cboXDosage.Text,count+1,Length(cboXDosage.text)); 3481 infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK); 3482 cboXDosage.Text := temp1 + temp2; 3483 end; 3047 3484 grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text; 3048 3485 UpdateRelated; … … 3085 3522 3086 3523 procedure TfrmODMeds.cboXDosageExit(Sender: TObject); 3087 begin 3088 inherited; 3089 cboXDosageClick(Self); 3090 cboXDosage.Tag := -1; 3091 cboXDosage.Hide; 3092 UpdateRelated; 3093 RestoreDefaultButton; 3094 RestoreCancelButton; 3095 if (pnlMessage.Visible) and (memMessage.TabStop) then 3096 begin 3097 pnlMessage.Parent := grdDoses.Parent; 3098 pnlMessage.TabOrder := grdDoses.TabOrder; 3099 ActiveControl := memMessage; 3100 end 3101 else if grdDoses.Showing then 3102 ActiveControl := grdDoses 3103 else 3104 ActiveControl := cboDosage; 3105 end; 3524 var 3525 //tempTag: integer; 3526 str: string; 3527 begin 3528 inherited; 3529 if cboXDosage.Showing then 3530 begin 3531 cboXDosageClick(Self); 3532 str := cboXDosage.Text; 3533 //tempTag := cboXDosage.Tag; 3534 //cboXDosage.Tag := -1; 3535 cboXDosage.Hide; 3536 UpdateRelated; 3537 RestoreDefaultButton; 3538 RestoreCancelButton; 3539 (*Probably not needed here since on validation check on accept 3540 if (LeftStr(cboXDosage.Text,1)='.') and (self.tabDose.TabIndex = TI_COMPLEX) then 3541 begin 3542 infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK); 3543 //cboXDosage.Tag := tempTag; 3544 cboXDosage.Show; 3545 cboXDosage.SetFocus; 3546 Exit; 3547 end; *) 3548 if (length(cboxdosage.Text)>0) and (cboxDosage.ItemIndex > -1) and 3549 (Piece(cboxDosage.Items.Strings[cboxDosage.ItemIndex],U,5) <> Piece(cboxDosage.Text,'#',1)) then 3550 begin 3551 cboXDosage.ItemIndex := -1; 3552 cboXDosage.Text := Piece(str, '#', 1); 3553 self.grdDoses.Cells[COL_DOSAGE,self.grdDoses.row] := cboXDosage.Text; 3554 UpdateRelated(false); 3555 end; 3556 if (pnlMessage.Visible) and (memMessage.TabStop) then 3557 begin 3558 pnlMessage.Parent := grdDoses.Parent; 3559 pnlMessage.TabOrder := grdDoses.TabOrder; 3560 ActiveControl := memMessage; 3561 end 3562 else if grdDoses.Showing then 3563 ActiveControl := grdDoses 3564 else 3565 ActiveControl := cboDosage; 3566 end 3567 else 3568 cmdQuit.Click; 3569 end; 3106 3570 3107 3571 procedure TfrmODMeds.cboXRouteChange(Sender: TObject); … … 3175 3639 if (FInptDlg) and (cboXSchedule.Text = 'OTHER') then 3176 3640 begin 3641 cboXSchedule.SelectByID('OTHER'); 3177 3642 othSch := CreateOtherScheduelComplex; 3178 3643 if length(trim(othSch)) > 1 then 3179 3644 begin 3645 othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime; 3180 3646 cboXSchedule.Items.Add(othSch); 3181 idx := cboXSchedule.Items.IndexOf( OthSch);3647 idx := cboXSchedule.Items.IndexOf(Piece(OthSch, U, 1)); 3182 3648 cboXSchedule.ItemIndex := idx; 3183 3649 end; 3184 3650 end; 3185 (* if chkXPRN.Checked then PRN := ' PRN' else PRN := ''; 3186 with cboXSchedule do if ItemIndex > -1 3187 then x := Text + PRN + TAB + Items[ItemIndex] 3188 else x := Text + PRN; *) 3651 if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row; 3652 //if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row; 3189 3653 with cboXSchedule do if ItemIndex > -1 3190 3654 then x := Text + TAB + Items[ItemIndex] … … 3192 3656 grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x; 3193 3657 self.cboSchedule.Text := x; 3658 //AGP Start Expired uncommented out the line 3659 if FInptDlg then UpdateStartExpires(Piece(x, tab, 1)); 3194 3660 UpdateRelated; 3195 3661 end; … … 3198 3664 procedure TfrmODMeds.cboXScheduleClick(Sender: TObject); 3199 3665 var 3200 x: string; 3201 begin 3202 inherited; 3203 //if chkXPRN.Checked then PRN := ' PRN' else PRN := ''; 3666 PRN,x: string; 3667 begin 3668 inherited; 3669 //agp change CQ 11015 3670 if (chkXPRN.Checked) then PRN := ' PRN' else PRN := ''; 3671 with cboXSchedule do 3672 begin 3673 if RightStr(Text,3) = 'PRN' then PRN := ''; 3674 if ItemIndex > -1 then x := Text + PRN + TAB + Items[ItemIndex] 3675 else x := Text + PRN; 3676 end; 3204 3677 (* with cboXSchedule do if ItemIndex > -1 3205 then x := Text + PRN + TAB + Items[ItemIndex]3206 else x := Text + PRN; *)3207 with cboXSchedule do if ItemIndex > -13208 3678 then x := Text + TAB + Items[ItemIndex] 3209 else x := Text; 3210 (* if (Pos('PRN',X)>0) and (pnlXSchedule.Tag = 1) then 3211 if lblAdmintime.visible then 3212 lblAdmintime.Caption := ''; *) 3679 else x := Text; *) 3213 3680 grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x; 3214 UpdateStartExpires(x); 3681 //AGP Start Expired uncommented out the line 3682 UpdateStartExpires(Piece(x, tab, 1)); 3215 3683 UpdateRelated; 3216 3684 end; … … 3248 3716 else 3249 3717 ActiveControl := cboDosage; 3718 //AGP Start Expired commented out the line 3719 //updateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row)); 3720 end; 3721 3722 procedure TfrmODMeds.pnlXAdminTimeClick(Sender: TObject); 3723 var 3724 Str: string; 3725 begin 3726 inherited; 3727 if not FInptDlg then Exit; 3728 3729 str := 'The Administration Times for this dose are: ' + CRLF + CRLF + VALFOR(VAL_ADMINTIME,grddoses.Row); 3730 str := str + CRLF + CRLF + AdminTimeHelpText; 3731 infoBox(str,'Administration Time Information',MB_OK); 3250 3732 end; 3251 3733 … … 3272 3754 if (Code <> 0) {and (I=0)} then 3273 3755 begin 3274 ShowM essage('Please use numeric characters only.');3756 ShowMsg('Please use numeric characters only.'); 3275 3757 with txtXDuration do 3276 3758 begin … … 3305 3787 begin 3306 3788 grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := ''; 3307 pnlXSequence.Tag := ARow1;3308 pnlXSequence.Caption:= '';3309 grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag]:= '';3310 btnXSequence.Click;3789 cboXSequence.Tag := ARow1; 3790 grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := ''; 3791 cboXSequence.Text := ''; 3792 cboXSequence.ItemIndex := -1; 3311 3793 end 3312 3794 else … … 3340 3822 end; 3341 3823 3342 procedure TfrmODMeds.btnXSequenceClick(Sender: TObject);3343 var3344 APoint: TPoint;3345 begin3346 inherited;3347 inherited;3348 with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));3349 popXSequence.Popup(APoint.X, APoint.Y);3350 pnlXSequence.Caption := btnXSequence.Caption;3351 {3352 with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));3353 popXSequence.Popup(APoint.X, APoint.Y);3354 pnlXSequence.Caption := btnXSequence.Caption;3355 if (pnlXSequence.Caption = 'then') and3356 ((ValFor(COL_DURATION, ARow1) = '') or3357 (ValFor(COL_DURATION, ARow1) = '0')) then3358 begin3359 InfoBox('A duration is required when using "Then" as a conjunction','Duration Warning',MB_OK);3360 pnlXSequence.Caption := '';3361 btnXSequence.Caption := '';3362 end;3363 }3364 end;3365 3366 procedure TfrmODMeds.popXSequenceClick(Sender: TObject);3367 var3368 x: string;3369 begin3370 inherited;3371 with TMenuItem(Sender) do if Tag > 0 then x := Caption else x := '';3372 //AGP Changes 26.12 PSI-04-633373 //if ((x = 'then') and (FInptDlg)) and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then3374 //AGP change 26.32 Then/And conjunction requiring a duration to include outpatient orders3375 if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then3376 begin3377 InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+3378 'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK);3379 x := '';3380 end;3381 btnXSequence.Caption := x;3382 pnlXSequence.Caption := btnXSequence.Caption;3383 grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := Uppercase(x);3384 ControlChange(Sender);3385 end;3386 3387 procedure TfrmODMeds.pnlXSequenceExit(Sender: TObject);3388 begin3389 inherited;3390 grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := Uppercase(btnXSequence.Caption);3391 if ActiveControl = grdDoses then3392 begin3393 //This next condition seldom occurs, since entering the dosage on the last3394 // row adds another row3395 if grdDoses.Row = grdDoses.RowCount - 1 then3396 grdDoses.RowCount := grdDoses.RowCount + 1;3397 end;3398 pnlXSequence.Tag := -1;3399 pnlXSequence.Hide;3400 RestoreDefaultButton;3401 RestoreCancelButton;3402 if (pnlMessage.Visible) and (memMessage.TabStop) then3403 begin3404 pnlMessage.Parent := grdDoses.Parent;3405 pnlMessage.TabOrder := grdDoses.TabOrder;3406 ActiveControl := memMessage;3407 end3408 else if grdDoses.Showing then3409 ActiveControl := grdDoses3410 else3411 ActiveControl := cboDosage;3412 end;3413 3824 3414 3825 procedure TfrmODMeds.btnXInsertClick(Sender: TObject); … … 3463 3874 Schedule <TAB> (nothing) 3464 3875 Duration <TAB> Duration^Units } 3876 3877 // the following functions were created to get rid of a compile warning saying the 3878 // return value may be undefined - too much branching logic in the case statements 3879 // for the compiler to handle 3880 3881 function GetSingleDoseSchedule: string; 3882 begin 3883 Result := UpperCase(Trim(cboSchedule.Text)); 3884 if chkPRN.Checked then Result := Result + ' PRN'; 3885 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' 3886 then Result := Copy(Result, 1, Length(Result) - 4); 3887 end; 3888 3889 function GetSingleDoseScheduleEX: string; 3890 begin 3891 Result := ''; 3892 with cboSchedule do 3893 begin 3894 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2); 3895 (* if (Length(Result)=0) and (ItemIndex > -1) then 3896 begin 3897 Result := Piece(Items[ItemIndex], U, 1); 3898 if Piece(Items[ItemIndex], U, 3) = 'P' then 3899 begin 3900 if RightStr(Result,3) = 'PRN' then 3901 begin 3902 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN 3903 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then 3904 Result := Copy(Result,1,Length(Result)-1); 3905 end; 3906 Result := Result + ' AS NEEDED'; 3907 end; 3908 end; 3909 end; *) 3910 if RightStr(Result,3) = 'PRN' then 3911 begin 3912 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN 3913 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then 3914 Result := Copy(Result,1,Length(Result)-1); 3915 Result := Result + ' AS NEEDED' 3916 end; 3917 if (Length(Result) > 0) and chkPRN.Checked then 3918 Result := Result + ' AS NEEDED'; 3919 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' then 3920 Result := Copy(Result, 1, Length(Result) - 10); 3921 if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then 3922 begin 3923 Result := Copy(Result, 1, Length(Result) - 13); 3924 if RightStr(Result,1)=' ' then 3925 Result := Result + 'AS NEEDED' 3926 else 3927 Result := Result + ' AS NEEDED'; 3928 end; 3929 end; 3930 end; 3931 3932 function GetComplexDoseSchedule: string; 3933 begin 3934 with grdDoses do 3935 begin 3936 Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1); 3937 if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 3938 if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN'; 3939 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then 3940 Result := Copy(Result, 1, Length(Result) - 4); 3941 end; 3942 end; 3943 3944 function GetComplexDoseScheduleEX: string; 3945 begin 3946 with grdDoses do 3947 begin 3948 (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2); 3949 if Result = '' then //Added for CQ: 7639 3950 begin 3951 Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 3952 if RightStr(Result,4) = ' PRN' then 3953 Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN 3954 end; 3955 if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <> 3956 Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and 3957 (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0) 3958 then Result := Result + ' AS NEEDED'; 3959 end;*) 3960 Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2); 3961 if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639 3962 if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 3963 if RightStr(Result,3) = 'PRN' then 3964 begin 3965 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN 3966 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then 3967 Result := Copy(Result,1,Length(Result)-1); 3968 Result := Result + ' AS NEEDED'; 3969 end; 3970 if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED'; 3971 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' 3972 then Result := Copy(Result, 1, Length(Result) - 10); 3973 if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then 3974 begin 3975 Result := Copy(Result, 1, Length(Result) - 13); 3976 if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED' 3977 else Result := Result + ' AS NEEDED'; 3978 end; 3979 end; 3980 end; 3981 3465 3982 begin 3466 3983 Result := ''; … … 3496 4013 FLD_ROUTE_EX : with cboRoute do 3497 4014 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4); 3498 FLD_SCHEDULE : begin //gary) 3499 Result := UpperCase(Trim(cboSchedule.Text)); 3500 if chkPRN.Checked then Result := Result + ' PRN'; 3501 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' 3502 then Result := Copy(Result, 1, Length(Result) - 4); 4015 FLD_SCHEDULE : begin 4016 Result := GetSingleDoseSchedule; 3503 4017 end; 3504 4018 FLD_SCHED_EX : begin 3505 with cboSchedule do 3506 begin 3507 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2); 3508 (* if (Length(Result)=0) and (ItemIndex > -1) then 3509 begin 3510 Result := Piece(Items[ItemIndex], U, 1); 3511 if Piece(Items[ItemIndex], U, 3) = 'P' then 3512 begin 3513 if RightStr(Result,3) = 'PRN' then 3514 begin 3515 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN 3516 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then 3517 Result := Copy(Result,1,Length(Result)-1); 3518 end; 3519 Result := Result + ' AS NEEDED'; 3520 end; 3521 end; 3522 end; *) 3523 if RightStr(Result,3) = 'PRN' then 3524 begin 3525 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN 3526 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then 3527 Result := Copy(Result,1,Length(Result)-1); 3528 Result := Result + ' AS NEEDED' 3529 end; 3530 if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED'; 3531 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' 3532 then Result := Copy(Result, 1, Length(Result) - 10); 3533 if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then 3534 begin 3535 Result := Copy(Result, 1, Length(Result) - 13); 3536 if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED' 3537 else Result := Result + ' AS NEEDED'; 3538 end; 3539 end; 4019 Result := GetSingleDoseScheduleEX; 3540 4020 end; 3541 4021 FLD_SCHED_TYP : with cboSchedule do … … 3578 4058 FLD_ROUTE_EX : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 4); 3579 4059 FLD_SCHEDULE : begin 3580 Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1); 3581 if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 3582 if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN'; 3583 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then 3584 Result := Copy(Result, 1, Length(Result) - 4); 4060 Result := GetComplexDoseSchedule; 3585 4061 end; 3586 4062 FLD_SCHED_EX : begin 3587 (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2); 3588 if Result = '' then //Added for CQ: 7639 3589 begin 3590 Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 3591 if RightStr(Result,4) = ' PRN' then 3592 Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN 3593 end; 3594 if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <> 3595 Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and 3596 (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0) 3597 then Result := Result + ' AS NEEDED'; 3598 end;*) 3599 Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2); 3600 if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639 3601 if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); 3602 if RightStr(Result,3) = 'PRN' then 3603 begin 3604 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN 3605 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then 3606 Result := Copy(Result,1,Length(Result)-1); 3607 Result := Result + ' AS NEEDED'; 3608 end; 3609 if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED'; 3610 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' 3611 then Result := Copy(Result, 1, Length(Result) - 10); 3612 if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then 3613 begin 3614 Result := Copy(Result, 1, Length(Result) - 13); 3615 if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED' 3616 else Result := Result + ' AS NEEDED'; 3617 end; 4063 Result := GetComplexDoseScheduleEX; 3618 4064 end; 3619 4065 FLD_SCHED_TYP : Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 3); … … 3641 4087 FLD_PRIOR_NM : Result := cboPriority.Text; 3642 4088 FLD_COMMENT : Result := memComment.Text; 3643 FLD_SC : if chkSC.Visible then 3644 begin 3645 if chkSC.Checked then Result := '1' else Result := '0'; 3646 end; 4089 3647 4090 FLD_NOW_ID : if chkDoseNow.Visible and chkDoseNow.Checked then Result := '1' else Result := ''; 3648 4091 FLD_NOW_NM : if chkDoseNow.Visible and chkDoseNow.Checked then Result := 'NOW' else Result := ''; … … 3682 4125 var 3683 4126 ADrug: string; 3684 begin 4127 Checked: boolean; 4128 tmpSupply: integer; 4129 begin 4130 Checked := false; 3685 4131 if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and 3686 4132 (txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> '')) 3687 or ((cboDosage.ItemIndex < 0) and not FIsQuickOrder ) then 3688 begin 4133 or ((cboDosage.ItemIndex < 0) and (not FIsQuickOrder)) or 4134 ((IsClozapineOrder = true) and (FISQuickOrder) and (FQOInitial)) then 4135 begin 4136 Checked := True; 3689 4137 ADrug := Piece(CurDispDrug, U, 1); 3690 4138 CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule); … … 3694 4142 if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then 3695 4143 txtSupply.Text := IntToStr(CurSupply); 3696 if (FIsQuickOrder and FQOInitial) then4144 if (FIsQuickOrder) and (FQOInitial) and (IsClozapineOrder = false) then 3697 4145 begin 3698 4146 if StrToFloatDef(txtSupply.Text,0) > 0 then … … 3712 4160 SkipQtyCheck := TRUE; 3713 4161 end; 3714 end; 4162 if FQOInitial = true then FQOInitial := False; 4163 end; 4164 if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then 4165 begin 4166 ADrug := Piece(CurDispDrug, U, 1); 4167 tmpSupply := DefaultDays(ADrug, CurUnits, CurSchedule); 4168 if (tmpSupply > 0) and (CurSupply > tmpSupply) then 4169 begin 4170 CurSupply := tmpSupply; 4171 spnSupply.Position := CurSupply; 4172 if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then 4173 txtSupply.Text := IntToStr(CurSupply); 4174 end; 4175 CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug); 4176 if CurQuantity >= 0 then 4177 begin 4178 //spnQuantity.Position := CurQuantity; 4179 if (txtQuantity.Text <> '') and (CurQuantity > 0) then 4180 txtQuantity.Text := FloatToStr(CurQuantity); 4181 if (txtQuantity.Text = '') or (StrToInt(txtQuantity.Text) <> CurQuantity) and (CurQuantity > 0) then 4182 txtQuantity.Text := FloatToStr(CurQuantity); 4183 end; 4184 end; 3715 4185 end; 3716 4186 … … 3808 4278 end; 3809 4279 3810 procedure TfrmODMeds.UpdateSC(const CurDispDrug: string); 3811 var 3812 Dispense: Integer; 3813 begin 3814 Dispense := StrToIntDef(Piece(CurDispDrug, U, 1), 0); // just use first dispense drug for now 3815 if Patient.ServiceConnected and RequiresCopay(Dispense) then 3816 begin 3817 chkSC.Visible := True; 3818 if chkSC.Tag = 0 then chkSC.Checked := Patient.SCPercent > 50; 3819 if chkSC.Hint = '' then chkSC.Hint := RatedDisabilities; 3820 end 3821 else chkSC.Visible := False; 3822 FUpdated := True; 4280 procedure TfrmODMeds.updateSig; 4281 begin 4282 inherited; 4283 if self.tabDose.TabIndex = TI_DOSE then self.cboDosage.OnExit(cboDosage); 4284 if self.tabDose.TabIndex = TI_COMPLEX then self.cboxDosage.OnExit(cboxDosage); 3823 4285 end; 3824 4286 3825 4287 procedure TfrmODMeds.UpdateStartExpires(const CurSchedule: string); 3826 4288 var 3827 CompSch, ShowText, Duration, ASchedule: string;4289 CompSch, CompDose, LastSch, ShowText, Duration, ASchedule, TempSch, schType, Admin, tempAdmin: string; 3828 4290 AdminTime: TFMDateTime; 3829 i, j, Interval, PrnPos: Integer; 3830 begin 4291 j, r, Interval, PrnPos, SchID: Integer; 4292 EndCheck, rowCheck, DoseNow: boolean; 4293 begin 4294 if not FInptDlg then Exit; 3831 4295 if Length(CurSchedule)=0 then Exit; 3832 4296 ASchedule := Trim(CurSchedule); 4297 DoseNow := True; 4298 if self.EvtID > 0 then DoseNow := false; 3833 4299 if (Pos('^',ASchedule)>0) then 3834 4300 begin … … 3837 4303 Delete(ASchedule, PrnPos-1, 4); 3838 4304 end; 4305 if (FAdminTimeText = '') and (self.EvtID > 0) then FAdminTimeText := 'To Be Determined'; 4306 AdminTime := 0; 3839 4307 ASchedule := Trim(ASchedule); 4308 //AGP Change for CQ 9906 4309 EndCheck := False; 4310 lastSch := ''; 3840 4311 if self.tabDose.TabIndex = TI_COMPLEX then 3841 4312 begin 3842 CompSch := valFor(VAL_SCHEDULE,1); 3843 if CompSch = '' then 3844 begin 3845 ASchedule := ''; 3846 AdminTime := -1; 3847 end; 3848 if CompSch <> '' then 3849 begin 3850 for i := 0 to self.cboXSchedule.Items.Count-1 do 3851 begin 3852 if (Piece(self.cboXSchedule.Items.Strings[i],U,1) = CompSch) and (Piece(self.cboXSchedule.Items.Strings[i],U,3)='P') then 4313 tempSch := ASchedule; 4314 ASchedule := ''; 4315 for r := 1 to self.grdDoses.RowCount-1 do 4316 begin 4317 CompSch := valFor(VAL_SCHEDULE,r); 4318 CompDose := valFor(VAL_DOSAGE,r); 4319 RowCheck := valFor(VAL_CHKXPRN,r)='1'; 4320 if (RowCheck = True) then 4321 begin 4322 if EndCheck = false then AdminTime := -1; 4323 if FAdminTimeText = '' then self.grdDoses.cells[COL_ADMINTIME, r] := '' 4324 else Self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText; 4325 end 4326 else 4327 begin 4328 if CompSch <> '' then 4329 begin 4330 //cboXSchedule.Items.IndexOfName(CompSch); 4331 //cboXSchedule.SelectByID(CompSch); 4332 SchID := -1; 4333 for j := 0 to cboXSchedule.Items.Count - 1 do 4334 begin 4335 if Piece(cboXSchedule.Items.Strings[j], U, 1) = CompSch then 4336 begin 4337 schID := j; 4338 break; 4339 end; 4340 end; 4341 //if cboXSchedule.ItemIndex > -1 then 4342 if SchID > -1 then 4343 begin 4344 //SchID := cboXSchedule.ItemIndex; 4345 if (Piece(self.cboXSchedule.Items.Strings[SchID],U,1) = CompSch) then 4346 begin 4347 SchType := Piece(self.cboXSchedule.Items.Strings[SchID],U,3); 4348 if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') then 4349 self.grdDoses.Cells[COL_ADMINTIME, r] := '' 4350 else if FAdminTimeText <> '' then self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText 4351 else 4352 begin 4353 self.grdDoses.Cells[COL_ADMINTIME, r] := Piece(self.cboXSchedule.Items.Strings[SchID],U,4); 4354 if self.grdDoses.Cells[COL_ADMINTIME, r] = '' then self.grdDoses.Cells[COL_ADMINTIME, r] := 'Not Defined'; 4355 4356 end; 4357 if CompDose <> '' then 4358 begin 4359 lastSch := CompSch; 4360 if (EndCheck = False) and ((SchType = 'P') or (SchType = 'O')) then AdminTime := -1 4361 //else Aschedule := ';' + CompSch; 4362 end; 4363 end; 4364 4365 end; 4366 end; 4367 end; 4368 if ((valFor(VAL_SEQUENCE,r) = 'AND') or (valFor(VAL_SEQUENCE,r) = '')) and (AdminTime > -1) and (EndCheck = false) then 4369 begin 4370 //if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch; 4371 if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch; 4372 if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch; 4373 end 4374 else if ValFor(VAL_SEQUENCE, r) = 'THEN' then 4375 begin 4376 // if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch; 4377 if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch; 4378 if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch; 4379 EndCheck := True; 4380 end 4381 end; 4382 end; 4383 if self.tabDose.TabIndex = TI_DOSE then 4384 begin 4385 if LeftStr(ASchedule, 1) = ';' then tempSch := Piece(ASchedule, ';', 2) 4386 else tempSch := ASchedule; 4387 if self.chkPRN.Checked = True then 4388 begin 4389 AdminTime := -1; 4390 lblAdminSchSetText(''); 4391 if (cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[cboSchedule.itemIndex], U, 3) = 'O') then 4392 DoseNow := false; 4393 end 4394 else begin 4395 //cboSchedule.SelectByID(tempSch); 4396 SchID := -1; 4397 for j := 0 to cboSchedule.Items.Count - 1 do 4398 begin 4399 if Piece(cboSchedule.Items.Strings[j], U, 1) = tempSch then 3853 4400 begin 3854 AdminTime := -1;3855 Aschedule := '';4401 schID := j; 4402 break; 3856 4403 end; 3857 end; 3858 end; 3859 if valFor(VAL_CHKXPRN,1)='1' then 3860 begin 3861 AdminTime := -1; 3862 Aschedule := ''; 3863 end; 3864 if (ASchedule <> '') and (CompSch <> '') then ASchedule := ';' + CompSch; 3865 end; 3866 if Length(ASchedule)>0 then 3867 LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration); 3868 //else Exit; 3869 if (AdminTime > 0) and (self.tabDose.TabIndex = TI_DOSE) then 3870 begin 3871 if self.cboSchedule.ItemIndex = -1 then 3872 begin 3873 for j := 0 to self.cboSchedule.items.Count -1 do 4404 end; 4405 if schID > -1 then 3874 4406 begin 3875 if (Piece(self.cboSchedule.Items.Strings[j],U,1) = Piece(Aschedule,';',2)) and (Piece(self.cboSchedule.Items.Strings[j],U,3)='P') then 4407 SchType := Piece(self.cboSchedule.Items.Strings[schID], U, 3); 4408 if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then 3876 4409 begin 3877 AdminTime := -1; 3878 break; 4410 lblAdminSchSetText(''); 4411 if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then AdminTime := -1; 4412 if SchType = 'O' then DoseNow := false; 4413 end 4414 else 4415 begin 4416 if FAdminTimeText <> '' then tempAdmin := 'Admin. Time: ' + FAdminTimeText 4417 else 4418 begin 4419 if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then 4420 tempAdmin := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4) 4421 else tempAdmin := 'Admin. Time: Not Defined'; 4422 end; 4423 lblAdminSchSetText(tempAdmin); 4424 (* if FAdminTimeText <> '' then self.lblAdminSch.text := 'Admin. Time: ' + FAdminTimeText 4425 else 4426 begin 4427 if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then 4428 self.lblAdminSch.text := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4) 4429 else self.lblAdminSch.text := 'Admin. Time: Not Defined'; 4430 end; *) 4431 3879 4432 end; 3880 4433 end; 3881 4434 end; 3882 if (self.cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.ItemIndex],U,3)='P') then 3883 AdminTime := -1; 3884 if self.chkPRN.Checked = true then AdminTime := -1 3885 end; 4435 end; 4436 if (Length(ASchedule)>0) and (AdminTime > -1) then 4437 begin 4438 if LeftStr(Aschedule, 1) <> ';' then ASchedule := ';'+ASchedule; 4439 Admin := ''; 4440 if (self.lblAdminSch.visible = True) and (self.lblAdminSch.text <> '') and (self.tabDose.TabIndex = TI_DOSE) then 4441 begin 4442 //AGP Change Admin Time Wrap 27.73 4443 //Admin := Copy(self.lblAdminSch.text, 14, (Length(self.lblAdminSch.text)-1)); 4444 Admin := lblAdminSchGetText; 4445 if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := ''; 4446 end 4447 else if self.tabDose.TabIndex = TI_COMPLEX then 4448 begin 4449 Admin := Self.grdDoses.Cells[COL_ADMINTIME, 1]; 4450 if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := ''; 4451 end; 4452 LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration, Admin); 4453 end; 3886 4454 if AdminTime > 0 then 3887 4455 begin … … 3906 4474 end 3907 4475 else lblAdminTime.Caption := ''; 4476 if (lblAdminTime.Caption <> '') and (lblAdminTime.Visible = True) and (JAWSON = true) then lblAdminTime.TabStop := true 4477 else lblAdminTime.TabStop := false; 4478 if (lblAdminSch.text <> '') and (lblAdminSch.Visible = True) and (JAWSON = true) then lblAdminSch.TabStop := true 4479 else lblAdminSch.TabStop := false; 4480 DisplayDoseNow(DoseNow); 3908 4481 end; 3909 4482 … … 3914 4487 else 3915 4488 spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, Responses.EventType = 'D'); 3916 if StrToIntDef(txtRefills.Text, 0) > spnRefills.Maxthen4489 if (StrToIntDef(txtRefills.Text, 0) > spnRefills.Max) then 3917 4490 begin 3918 4491 txtRefills.Text := IntToStr(spnRefills.Max); … … 3940 4513 CurSupply, i, pNum, j: Integer; 3941 4514 CurQuantity: double; 3942 LackQtyInfo, SaveChanging , DispFirstDose: Boolean;4515 LackQtyInfo, SaveChanging: Boolean; 3943 4516 begin 3944 4517 inherited; … … 3947 4520 SaveChanging := Changing; 3948 4521 Changing := TRUE; 3949 DispFirstDose := FALSE;3950 4522 // don't allow Exit procedure so Changing gets reset appropriately 3951 4523 CurUnits := ''; … … 3997 4569 CurQuantity := StrToFloatDef(ValueOfResponse(FLD_QUANTITY), 0); 3998 4570 CurSupply := StrToIntDef(ValueOfResponse(FLD_SUPPLY) ,0); 4571 //CurRefill := StrToIntDef(ValueOfResponse(FLD_REFILLS) , 0); 3999 4572 if FInptDlg then 4000 4573 begin … … 4006 4579 lblAdminTime.Caption := ''; 4007 4580 end; 4008 if CurSchedule <> FLastSchedule then UpdateStartExpires(CurSchedule); 4009 if (ValueOf(FLD_SCHED_TYP) = 'O') 4581 if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then UpdateStartExpires(CurSchedule); 4582 //AGP remove this code for CQ 11772 4583 (*if (ValueOf(FLD_SCHED_TYP) = 'O') 4010 4584 or (Responses.EventType in ['A','D','T','M','O']) 4011 4585 or ((Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0)) then … … 4016 4590 chkDoseNow.Checked := False; 4017 4591 end; 4018 for i := 0 to cboSchedule.Items.Count-1 do4019 begin4020 if Piece(cboSchedule.Items.Strings[i],U,1) = Uppercase(cboSchedule.Text) then4021 begin4022 DispFirstDose := True;4023 break;4024 end;4025 end;4026 if not DispFirstDose then4027 begin4028 4592 chkDoseNow.Visible := False; 4029 4593 lblAdminTime.Visible := False; 4030 end;4031 4594 end 4032 4595 else … … 4034 4597 chkDoseNow.Visible := TRUE; 4035 4598 lblAdminTime.Visible := not chkDoseNow.Checked; 4036 end; 4599 end; *) 4037 4600 if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False; 4038 4601 end; … … 4040 4603 begin 4041 4604 CurSchedule := CurScheduleOut; 4042 if ( CurInstruct <> FLastInstruct) and (CurUnits <> U) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server4605 if ((CurInstruct <> FLastInstruct) and (CurUnits <> U)) or ((IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server 4043 4606 then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity, 4044 4607 LackQtyInfo); … … 4049 4612 else 4050 4613 UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity); 4051 if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);4052 if ( CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)then4614 // if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug); 4615 if ((CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0)) then 4053 4616 UpdateRefills(CurDispDrug, CurSupply); 4054 4617 end; … … 4098 4661 then DisplayGroup := DisplayGroupByName('UD RX') 4099 4662 else DisplayGroup := DisplayGroupByName('O RX'); 4663 (* if (Not FInptDlg) then 4664 begin 4665 if (ValidateDaySupplyandQuantity(strtoInt(txtSupply.Text), strtoInt(txtQuantity.text)) = false) then Exit 4666 else ClearMaxData; 4667 end; *) 4668 //if (Not FInptDlg) and (ValidateMaxQuantity(strtoInt(txtQuantity.Text)) = false) then Exit; 4669 4670 4100 4671 //timCheckChangesTimer(Self); 4101 4672 DropLastSequence; … … 4135 4706 if length(theSch)>0 then 4136 4707 begin 4137 if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then 4708 //if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then 4709 if InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then 4138 4710 begin 4139 4711 chkDoseNow.Checked := False; … … 4152 4724 if (tabDose.TabIndex = TI_COMPLEX) and chkDoseNow.Checked then 4153 4725 begin 4154 if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF +4726 if (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF + 4155 4727 'Please adjust the duration of the first row, if necessary.', 4156 'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then4728 'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) then 4157 4729 begin 4158 4730 chkDoseNow.Checked := False; … … 4283 4855 case Key of 4284 4856 // VK_RETURN: //moved to form key press 4857 VK_RIGHT: 4858 begin 4859 if (not FInptDlg) and (self.grdDoses.Col = COL_DURATION) then 4860 begin 4861 self.grdDoses.Col := COL_SEQUENCE; 4862 Key := 0; 4863 end; 4864 end; 4865 VK_LEFT: 4866 begin 4867 if (not FInptDlg) and (self.grdDoses.Col = COL_SEQUENCE) then 4868 begin 4869 self.grdDoses.Col := COL_DURATION; 4870 Key := 0; 4871 end; 4872 end; 4285 4873 VK_ESCAPE: 4286 4874 begin … … 4377 4965 procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char); 4378 4966 begin 4379 if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then4967 (* if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then 4380 4968 begin 4381 4969 ShowEditor(grdDoses.Col, grdDoses.Row, #0); 4382 4970 Key := #0; //Don't let the base class turn it into a forward tab! 4383 end 4384 else if (Key = #13) and (ActiveControl = txtMed) then 4971 end *) 4972 //else 4973 if (Key = #13) and (ActiveControl = txtMed) then 4385 4974 Key := #0; //Don't let the base class turn it into a forward tab! 4386 4975 end; … … 4406 4995 end; 4407 4996 4408 procedure TfrmODMeds.pnl XSequenceEnter(Sender: TObject);4997 procedure TfrmODMeds.pnlMessageEnter(Sender: TObject); 4409 4998 begin 4410 4999 inherited; … … 4413 5002 end; 4414 5003 4415 procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);4416 begin4417 inherited;4418 DisableDefaultButton(self);4419 DisableCancelButton(self);4420 end;4421 4422 5004 procedure TfrmODMeds.pnlMessageExit(Sender: TObject); 4423 5005 begin … … 4441 5023 begin 4442 5024 inherited; 4443 ShowM essage('The patient instruction field may not be edited.');5025 ShowMsg('The patient instruction field may not be edited.'); 4444 5026 chkPtInstruct.SetFocus; 4445 5027 end; … … 4448 5030 var 4449 5031 aftHeight: integer; 5032 tempAdmin: string; 4450 5033 begin 4451 5034 inherited; … … 4456 5039 if pnlMessage.Visible then 4457 5040 pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8; 4458 end; 4459 4460 procedure TfrmODMeds.spnQuantityChangingEx(Sender: TObject; 4461 var AllowChange: Boolean; NewValue: Smallint; 4462 Direction: TUpDownDirection); 4463 var 4464 tempQuant: double; 4465 begin 4466 inherited; 4467 if Direction = updUp then 4468 begin 4469 tempQuant := StrToFloatDef(txtQuantity.Text,0) + 1; 4470 txtQuantity.Text := FloatToStr(tempQuant); 4471 end else if Direction = updDown then 4472 begin 4473 tempQuant := StrToFloatDef(txtQuantity.Text,0) - 1 ; 4474 if tempQuant < 0 then tempQuant := 0; 4475 txtQuantity.Text := FloatToStr(tempQuant); 4476 end; 4477 spnQuantity.Tag := 1; 4478 txtQuantity.Tag := 1; 5041 tempAdmin := lblAdminSchGetText; 5042 if tempAdmin <> '' then lblAdminSchSetText('Admin Time: ' + tempAdmin); 4479 5043 end; 4480 5044 … … 4483 5047 begin 4484 5048 inherited; 4485 ShowM essage('The patient instruction field may not be edited.');5049 ShowMsg('The patient instruction field may not be edited.'); 4486 5050 chkPtInstruct.SetFocus; 4487 5051 end; … … 4553 5117 cboSchedule.ItemIndex := -1; 4554 5118 cboSchedule.Text := ''; 4555 end; 4556 Result := aSchedule; 5119 end 5120 else 5121 begin 5122 Result := Piece(aSchedule,U,1); 5123 NSSAdminTime := Piece(aschedule,u,2); 5124 NSSScheduleType := Piece(aSchedule, U, 3); 5125 if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText; 5126 end; 4557 5127 end; 4558 5128 … … 4579 5149 (Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and 4580 5150 (Integer(lstQuick.Selected.Data) > 0)) ; 5151 if (btnSelect.Enabled) and (FOrderAction = ORDER_EDIT) then btnSelect.Enabled := false; 4581 5152 if (btnSelect.Enabled) and (FRemoveText) then 4582 5153 txtMed.Text := ''; 4583 5154 end; 4584 5155 5156 5157 procedure TfrmODMeds.DisplayDoseNow(Status: boolean); 5158 begin 5159 if not FinptDlg then Status := False; 5160 if Status = false then 5161 begin 5162 if (self.chkDoseNow.Visible = true) and (self.chkDoseNow.Checked = true) then self.chkDoseNow.Checked := false; 5163 self.chkDoseNow.Visible := false; 5164 end; 5165 if status = true then self.chkDoseNow.Visible := true; 5166 end; 4585 5167 4586 5168 procedure TfrmODMeds.DispOrderMessage(const AMessage: string); … … 4613 5195 procedure TfrmODMeds.FormClose(Sender: TObject; var Action: TCloseAction); 4614 5196 begin 5197 if FCloseCalled then Exit; //Temporary Hack: Close is called 2x for some reason & errors out 5198 FCloseCalled := true; 4615 5199 FResizedAlready := False; 4616 5200 inherited; … … 4626 5210 cboXSchedule.ItemIndex := -1; 4627 5211 cboXSchedule.Text := ''; 4628 end; 4629 Result := aSchedule; 5212 end 5213 else 5214 begin 5215 Result := Piece(aSchedule,U,1); 5216 NSSAdminTime := Piece(aschedule,u,2); 5217 NSSScheduleType := Piece(ASchedule, U, 3); 5218 if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText; 5219 end; 4630 5220 end; 4631 5221 … … 4660 5250 procedure TfrmODMeds.FormShow(Sender: TObject); 4661 5251 begin 5252 FCloseCalled := false; 4662 5253 inherited; 4663 5254 if ( (cboSchedule.Text = 'OTHER') and FNSSOther and FInptDlg )then 4664 5255 PostMessage(Handle, UM_NSSOTHER, 0, 0); 5256 5257 //I was using btnSelect.Top for the following, but it gets moved around 5258 Constraints.MinHeight := Constraints.MinHeight + ((Self.Height - cmdQuit.Top) * 2); 4665 5259 end; 4666 5260 … … 4697 5291 ScheduleCombo.ItemIndex := tmpIndex; 4698 5292 end; 4699 if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then4700 begin4701 FShowPnlXScheduleOk := False; //Added for CQ: 73704702 Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+5293 if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then 5294 begin 5295 FShowPnlXScheduleOk := False; //Added for CQ: 7370 5296 Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+ 4703 5297 'If you would like to create a Day-of-Week schedule please'+ 4704 5298 ' select ''OTHER'' from the list.', … … 4749 5343 4750 5344 // CQ: 7397 - Inpatient med orders with PRN cancel due to invalid schedule. 5345 function TfrmODMeds.GetCacheChunkIndex(idx: integer): integer; 5346 begin 5347 Result := idx div MED_CACHE_CHUNK_SIZE; 5348 end; 5349 4751 5350 function TfrmODMeds.GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer; 4752 5351 var i: integer; … … 4772 5371 end; 4773 5372 5373 procedure TfrmODMeds.cboXSequenceChange(Sender: TObject); 5374 var 5375 x: string; 5376 begin 5377 inherited; 5378 x := cboXSequence.Text; 5379 if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then 5380 begin 5381 InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+ 5382 'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK); 5383 x := ''; 5384 end; 5385 cboXSequence.text := x; 5386 cboXSequence.ItemIndex := cboXSequence.Items.IndexOf(x); 5387 grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(x); 5388 //AGP Start Expire add line 5389 UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row)); 5390 ControlChange(Sender); 5391 end; 5392 5393 procedure TfrmODMeds.cboXSequenceEnter(Sender: TObject); 5394 begin 5395 inherited; 5396 DisableDefaultButton(self); 5397 DisableCancelButton(self); 5398 end; 5399 5400 procedure TfrmODMeds.cboXSequenceExit(Sender: TObject); 5401 begin 5402 inherited; 5403 grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(cboXSequence.Text); 5404 if ActiveControl = grdDoses then 5405 begin 5406 //This next condition seldom occurs, since entering the dosage on the last 5407 // row adds another row 5408 if grdDoses.Row = grdDoses.RowCount - 1 then 5409 grdDoses.RowCount := grdDoses.RowCount + 1; 5410 end; 5411 cboXSequence.Tag := -1; 5412 cboXSequence.Hide; 5413 RestoreDefaultButton; 5414 RestoreCancelButton; 5415 if (pnlMessage.Visible) and (memMessage.TabStop) then 5416 begin 5417 pnlMessage.Parent := grdDoses.Parent; 5418 pnlMessage.TabOrder := grdDoses.TabOrder; 5419 ActiveControl := memMessage; 5420 end 5421 else if grdDoses.Showing then 5422 ActiveControl := grdDoses 5423 else 5424 ActiveControl := cboDosage; 5425 //AGP Start Expire commented out line 5426 //UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row)); 5427 end; 5428 5429 procedure TfrmODMeds.cboXSequence1Exit(Sender: TObject); 5430 begin 5431 inherited; 5432 cboxSequence.Hide; 5433 end; 5434 4774 5435 procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word; 4775 5436 Shift: TShiftState); … … 4778 5439 //Fix for CQ: 7545 4779 5440 if cboDosage.ItemIndex > -1 then 4780 cboDosageClick(Sender); 5441 cboDosageClick(Sender) 5442 else 5443 UpdateRelated; 4781 5444 end; 4782 5445 … … 4787 5450 //Fix for CQ: 7545 4788 5451 if cboXDosage.ItemIndex > -1 then 4789 cboXDosageClick(Sender); 5452 cboXDosageClick(Sender) 5453 else 5454 begin 5455 grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text; 5456 UpdateRelated; 5457 end; 4790 5458 end; 4791 5459 … … 4800 5468 inherited; 4801 5469 self.txtQuantity.SelectAll; 5470 end; 5471 5472 procedure TfrmODMeds.txtRefillsChange(Sender: TObject); 5473 begin 5474 inherited; 5475 ControlChange(sender); 4802 5476 end; 4803 5477 … … 4830 5504 begin 4831 5505 inherited; 4832 //agp Change CQ 10719 5506 //agp Change CQ 10719 4833 5507 self.chkXPRN.OnClick(self.chkXPRN); 4834 5508 end; 4835 5509 5510 4836 5511 end. -
cprs/trunk/CPRS-Chart/Orders/fODMessage.dfm
r456 r829 1 objectfrmODMessage: TfrmODMessage1 inherited frmODMessage: TfrmODMessage 2 2 Left = 271 3 3 Top = 515 … … 6 6 ClientHeight = 39 7 7 ClientWidth = 374 8 Color = clBtnFace9 Font.Charset = DEFAULT_CHARSET10 Font.Color = clWindowText11 Font.Height = -1112 Font.Name = 'MS Sans Serif'13 Font.Style = []14 8 FormStyle = fsStayOnTop 15 OldCreateOrder = False16 9 Position = poOwnerFormCenter 17 10 Visible = True 18 11 OnCreate = FormCreate 19 12 OnDestroy = FormDestroy 13 DesignSize = ( 14 374 15 39) 20 16 PixelsPerInch = 96 21 17 TextHeight = 13 22 object imgMessage: TImage 18 object imgMessage: TImage [0] 23 19 Left = 4 24 20 Top = 4 … … 26 22 Height = 32 27 23 end 28 object memMessage: TRichEdit 24 object memMessage: TRichEdit [1] 29 25 Left = 40 30 26 Top = 4 … … 42 38 TabOrder = 0 43 39 end 40 inherited amgrMain: TVA508AccessibilityManager 41 Data = ( 42 ( 43 'Component = memMessage' 44 'Status = stsDefault') 45 ( 46 'Component = frmODMessage' 47 'Status = stsDefault')) 48 end 44 49 end -
cprs/trunk/CPRS-Chart/Orders/fODMessage.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ExtCtrls, StdCtrls, ComCtrls ;7 ExtCtrls, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmODMessage = class(T Form)10 TfrmODMessage = class(TfrmBase508Form) 11 11 memMessage: TRichEdit; 12 12 imgMessage: TImage; -
cprs/trunk/CPRS-Chart/Orders/fODMisc.dfm
r456 r829 45 45 TabOrder = 7 46 46 end 47 object cboCare: TORComboBox 47 object cboCare: TORComboBox [8] 48 48 Left = 6 49 49 Top = 20 … … 59 59 ListItemsOnly = True 60 60 LongList = True 61 LookupPiece = 0 61 62 MaxLength = 0 62 63 Pieces = '2' … … 67 68 OnMouseClick = ControlChange 68 69 OnNeedData = cboCareNeedData 70 CharsNeedMatch = 1 69 71 end 70 object calStart: TORDateBox 72 object calStart: TORDateBox [9] 71 73 Left = 6 72 74 Top = 114 … … 80 82 Caption = 'Start Date/Time' 81 83 end 82 object calStop: TORDateBox 84 object calStop: TORDateBox [10] 83 85 Left = 158 84 86 Top = 114 … … 91 93 Caption = 'Stop Date/Time' 92 94 end 93 object txtComment: TCaptionEdit 95 object txtComment: TCaptionEdit [11] 94 96 Left = 6 95 97 Top = 67 … … 100 102 Caption = 'Instructions' 101 103 end 104 inherited amgrMain: TVA508AccessibilityManager 105 Data = ( 106 ( 107 'Component = cboCare' 108 'Status = stsDefault') 109 ( 110 'Component = calStart' 111 'Status = stsDefault') 112 ( 113 'Component = calStop' 114 'Status = stsDefault') 115 ( 116 'Component = txtComment' 117 'Status = stsDefault') 118 ( 119 'Component = memOrder' 120 'Status = stsDefault') 121 ( 122 'Component = cmdAccept' 123 'Status = stsDefault') 124 ( 125 'Component = cmdQuit' 126 'Status = stsDefault') 127 ( 128 'Component = pnlMessage' 129 'Status = stsDefault') 130 ( 131 'Component = memMessage' 132 'Status = stsDefault') 133 ( 134 'Component = frmODMisc' 135 'Status = stsDefault')) 136 end 102 137 end -
cprs/trunk/CPRS-Chart/Orders/fODMisc.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst; 7 fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst, 8 VA508AccessibilityManager; 8 9 9 10 type -
cprs/trunk/CPRS-Chart/Orders/fODRad.dfm
r456 r829 3 3 Left = 282 4 4 Top = 225 5 Width = 5 766 Height = 3615 Width = 586 6 Height = 404 7 7 Caption = 'Order an Imaging Procedure' 8 Constraints.MinHeight = 344 9 Constraints.MinWidth = 576 8 Constraints.MinHeight = 404 9 Constraints.MinWidth = 586 10 ExplicitLeft = 282 11 ExplicitTop = 225 12 ExplicitWidth = 586 13 ExplicitHeight = 404 10 14 PixelsPerInch = 96 11 15 TextHeight = 13 12 16 inherited memOrder: TCaptionMemo 13 17 Left = 0 14 Top = 28315 Width = 4 8018 Top = 326 19 Width = 490 16 20 Anchors = [akLeft, akRight, akBottom] 17 21 TabOrder = 6 22 ExplicitLeft = 0 23 ExplicitTop = 326 24 ExplicitWidth = 490 18 25 end 19 26 object FRadCommonCombo: TORListBox [1] 20 Left = 4 4321 Top = 3 4627 Left = 419 28 Top = 362 22 29 Width = 121 23 30 Height = 11 … … 34 41 Top = 0 35 42 Width = 215 36 Height = 28143 Height = 321 37 44 Anchors = [akLeft, akTop, akBottom] 38 45 BevelOuter = bvNone … … 40 47 object lblDrug: TLabel 41 48 Left = 0 42 Top = 3 849 Top = 34 43 50 Width = 89 44 51 Height = 13 … … 53 60 end 54 61 object lblImType: TLabel 55 Left = 156 Top = 162 Left = 0 63 Top = 0 57 64 Width = 64 58 65 Height = 13 … … 68 75 object cboImType: TORComboBox 69 76 Left = 0 70 Top = 1 577 Top = 13 71 78 Width = 212 72 79 Height = 21 … … 109 116 object cboProcedure: TORComboBox 110 117 Left = 0 111 Top = 53118 Top = 47 112 119 Width = 212 113 Height = 1 14120 Height = 122 114 121 Style = orcsSimple 115 122 AutoSelect = True … … 170 177 end 171 178 end 172 object pnlRight: TORAutoPanel [3] 173 Left = 214 174 Top = 85 175 Width = 355 176 Height = 195 177 Anchors = [akLeft, akRight, akBottom] 178 BevelOuter = bvNone 179 inherited cmdAccept: TButton 180 Left = 497 181 Top = 326 182 Anchors = [akRight, akBottom] 179 183 TabOrder = 3 180 object lblRequestDate: TLabel 181 Left = 4 182 Top = 5 183 Width = 78 184 Height = 13 185 Caption = 'Requested Date' 186 end 187 object lblUrgency: TLabel 188 Left = 104 189 Top = 5 190 Width = 40 191 Height = 13 192 Caption = 'Urgency' 193 end 194 object lblTransport: TLabel 195 Left = 204 196 Top = 5 197 Width = 45 198 Height = 13 199 Caption = 'Transport' 200 end 201 object lblCategory: TLabel 202 Left = 4 203 Top = 42 204 Width = 42 205 Height = 13 206 Caption = 'Category' 207 end 208 object lblSubmit: TLabel 209 Left = 154 210 Top = 42 211 Width = 48 212 Height = 13 213 Caption = 'Submit To' 214 end 215 object lblLastExam: TLabel 216 Left = 4 217 Top = 82 218 Width = 134 219 Height = 13 220 Caption = 'Exams Over the Last 7 Days' 221 end 222 object lblAskSubmit: TLabel 223 Left = 446 224 Top = 103 225 Width = 3 226 Height = 13 227 Visible = False 228 end 229 object lblPreOp: TLabel 230 Left = 198 231 Top = 156 232 Width = 84 233 Height = 13 234 Caption = 'PreOp Scheduled' 235 end 236 object calPreOp: TORDateBox 237 Left = 198 238 Top = 170 239 Width = 96 240 Height = 21 241 TabOrder = 8 242 OnChange = calPreOpChange 243 OnExit = calPreOpExit 244 DateOnly = False 245 RequireTime = False 246 Caption = 'PreOp Scheduled' 247 end 248 object chkIsolation: TCheckBox 249 Left = 198 250 Top = 94 251 Width = 97 252 Height = 17 253 Hint = 'Is patient on isolation procedures?' 254 Caption = 'Isolation' 255 ParentShowHint = False 256 ShowHint = True 257 TabOrder = 6 258 OnClick = ControlChange 259 OnExit = chkIsolationExit 260 end 261 object calRequestDate: TORDateBox 262 Left = 4 263 Top = 18 264 Width = 92 265 Height = 21 266 TabOrder = 0 267 Text = 'TODAY' 268 OnChange = ControlChange 269 DateOnly = False 270 RequireTime = False 271 Caption = 'Requested Date' 272 end 273 object cboUrgency: TORComboBox 274 Left = 104 275 Top = 18 276 Width = 92 277 Height = 21 278 Style = orcsDropDown 279 AutoSelect = True 280 Caption = 'Urgency' 281 Color = clWindow 282 DropDownCount = 8 283 ItemHeight = 13 284 ItemTipColor = clWindow 285 ItemTipEnable = True 286 ListItemsOnly = True 287 LongList = False 288 LookupPiece = 0 289 MaxLength = 0 290 Pieces = '2' 291 Sorted = False 292 SynonymChars = '<>' 293 TabOrder = 1 294 OnChange = ControlChange 295 CharsNeedMatch = 1 296 end 297 object cboTransport: TORComboBox 298 Left = 204 299 Top = 18 300 Width = 92 301 Height = 21 302 Style = orcsDropDown 303 AutoSelect = True 304 Caption = 'Transport' 305 Color = clWindow 306 DropDownCount = 8 307 ItemHeight = 13 308 ItemTipColor = clWindow 309 ItemTipEnable = True 310 ListItemsOnly = True 311 LongList = False 312 LookupPiece = 0 313 MaxLength = 0 314 Pieces = '2' 315 Sorted = False 316 SynonymChars = '<>' 317 TabOrder = 2 318 OnChange = ControlChange 319 CharsNeedMatch = 1 320 end 321 object cboCategory: TORComboBox 322 Left = 4 323 Top = 57 324 Width = 140 325 Height = 21 326 Style = orcsDropDown 327 AutoSelect = True 328 Caption = 'Category' 329 Color = clWindow 330 DropDownCount = 8 331 ItemHeight = 13 332 ItemTipColor = clWindow 333 ItemTipEnable = True 334 ListItemsOnly = True 335 LongList = False 336 LookupPiece = 0 337 MaxLength = 0 338 Pieces = '2' 339 Sorted = False 340 SynonymChars = '<>' 341 TabOrder = 3 342 OnChange = cboCategoryChange 343 CharsNeedMatch = 1 344 end 345 object chkPreOp: TCheckBox 346 Left = 146 347 Top = 233 348 Width = 61 349 Height = 17 350 Caption = 'Pre-Op' 351 TabOrder = 9 352 Visible = False 353 OnClick = ControlChange 354 end 355 object cboSubmit: TORComboBox 356 Left = 154 357 Top = 57 358 Width = 142 359 Height = 21 360 Style = orcsDropDown 361 AutoSelect = True 362 Caption = 'Submit To' 363 Color = clWindow 364 DropDownCount = 8 365 ItemHeight = 13 366 ItemTipColor = clWindow 367 ItemTipEnable = True 368 ListItemsOnly = True 369 LongList = False 370 LookupPiece = 0 371 MaxLength = 0 372 Pieces = '2' 373 Sorted = False 374 SynonymChars = '<>' 375 TabOrder = 4 376 OnChange = ControlChange 377 CharsNeedMatch = 1 378 end 379 object lstLastExam: TORListBox 380 Left = 4 381 Top = 95 382 Width = 187 383 Height = 98 384 Color = clBtnFace 385 ExtendedSelect = False 386 ItemHeight = 13 387 MultiSelect = True 388 ParentShowHint = False 389 ShowHint = True 390 TabOrder = 5 391 Caption = 'Exams Over the Last 7 Days' 392 ItemTipColor = clWindow 393 LongList = False 394 Pieces = '2' 395 end 396 object grpPregnant: TGroupBox 397 Left = 196 398 Top = 112 399 Width = 158 400 Height = 41 401 Caption = 'Pregnant' 402 TabOrder = 7 403 object radPregnant: TRadioButton 404 Left = 2 405 Top = 17 406 Width = 39 407 Height = 17 408 Caption = 'Yes' 409 TabOrder = 0 410 OnClick = ControlChange 411 end 412 object radPregnantNo: TRadioButton 413 Left = 47 414 Top = 17 415 Width = 35 416 Height = 17 417 Caption = 'No' 418 TabOrder = 1 419 OnClick = ControlChange 420 end 421 object radPregnantUnknown: TRadioButton 422 Left = 87 423 Top = 16 424 Width = 66 425 Height = 17 426 Caption = 'Unknown' 427 TabOrder = 2 428 OnClick = ControlChange 429 end 430 end 431 end 432 object pnlHandR: TPanel [4] 184 ExplicitLeft = 497 185 ExplicitTop = 326 186 end 187 object pnlRightBase: TORAutoPanel [4] 433 188 Left = 215 434 189 Top = 0 435 Width = 3 53436 Height = 84190 Width = 362 191 Height = 322 437 192 Anchors = [akLeft, akTop, akRight, akBottom] 438 193 BevelOuter = bvNone 439 TabOrder = 2 440 DesignSize = ( 441 353 442 84) 443 object lblReason: TLabel 444 Left = 3 194 Caption = 'pnlRightBase' 195 TabOrder = 1 196 object pnlRight: TORAutoPanel 197 Left = 0 198 Top = 127 199 Width = 362 200 Height = 195 201 Align = alBottom 202 Anchors = [akLeft, akTop, akRight, akBottom] 203 BevelOuter = bvNone 204 TabOrder = 1 205 object lblRequestDate: TLabel 206 Left = 4 207 Top = 5 208 Width = 62 209 Height = 13 210 Caption = 'Date Desired' 211 end 212 object lblUrgency: TLabel 213 Left = 104 214 Top = 5 215 Width = 40 216 Height = 13 217 Caption = 'Urgency' 218 end 219 object lblTransport: TLabel 220 Left = 204 221 Top = 5 222 Width = 45 223 Height = 13 224 Caption = 'Transport' 225 end 226 object lblCategory: TLabel 227 Left = 4 228 Top = 42 229 Width = 42 230 Height = 13 231 Caption = 'Category' 232 end 233 object lblSubmit: TLabel 234 Left = 154 235 Top = 42 236 Width = 48 237 Height = 13 238 Caption = 'Submit To' 239 end 240 object lblLastExam: TLabel 241 Left = 4 242 Top = 82 243 Width = 134 244 Height = 13 245 Caption = 'Exams Over the Last 7 Days' 246 end 247 object lblAskSubmit: TLabel 248 Left = 446 249 Top = 103 250 Width = 3 251 Height = 13 252 Visible = False 253 end 254 object lblPreOp: TLabel 255 Left = 198 256 Top = 156 257 Width = 84 258 Height = 13 259 Caption = 'PreOp Scheduled' 260 end 261 object calPreOp: TORDateBox 262 Left = 198 263 Top = 170 264 Width = 96 265 Height = 21 266 TabOrder = 8 267 OnChange = calPreOpChange 268 OnExit = calPreOpExit 269 DateOnly = False 270 RequireTime = False 271 Caption = 'PreOp Scheduled' 272 end 273 object chkIsolation: TCheckBox 274 Left = 198 275 Top = 94 276 Width = 97 277 Height = 17 278 Hint = 'Is patient on isolation procedures?' 279 Caption = 'Isolation' 280 ParentShowHint = False 281 ShowHint = True 282 TabOrder = 6 283 OnClick = ControlChange 284 OnExit = chkIsolationExit 285 end 286 object calRequestDate: TORDateBox 287 Left = 4 288 Top = 18 289 Width = 92 290 Height = 21 291 TabOrder = 0 292 OnChange = ControlChange 293 DateOnly = False 294 RequireTime = False 295 Caption = 'Date Desired' 296 end 297 object cboUrgency: TORComboBox 298 Left = 104 299 Top = 18 300 Width = 92 301 Height = 21 302 Style = orcsDropDown 303 AutoSelect = True 304 Caption = 'Urgency' 305 Color = clWindow 306 DropDownCount = 8 307 ItemHeight = 13 308 ItemTipColor = clWindow 309 ItemTipEnable = True 310 ListItemsOnly = True 311 LongList = False 312 LookupPiece = 0 313 MaxLength = 0 314 Pieces = '2' 315 Sorted = False 316 SynonymChars = '<>' 317 TabOrder = 1 318 OnChange = ControlChange 319 CharsNeedMatch = 1 320 end 321 object cboTransport: TORComboBox 322 Left = 204 323 Top = 18 324 Width = 92 325 Height = 21 326 Style = orcsDropDown 327 AutoSelect = True 328 Caption = 'Transport' 329 Color = clWindow 330 DropDownCount = 8 331 ItemHeight = 13 332 ItemTipColor = clWindow 333 ItemTipEnable = True 334 ListItemsOnly = True 335 LongList = False 336 LookupPiece = 0 337 MaxLength = 0 338 Pieces = '2' 339 Sorted = False 340 SynonymChars = '<>' 341 TabOrder = 2 342 OnChange = ControlChange 343 CharsNeedMatch = 1 344 end 345 object cboCategory: TORComboBox 346 Left = 4 347 Top = 57 348 Width = 140 349 Height = 21 350 Style = orcsDropDown 351 AutoSelect = True 352 Caption = 'Category' 353 Color = clWindow 354 DropDownCount = 8 355 ItemHeight = 13 356 ItemTipColor = clWindow 357 ItemTipEnable = True 358 ListItemsOnly = True 359 LongList = False 360 LookupPiece = 0 361 MaxLength = 0 362 Pieces = '2' 363 Sorted = False 364 SynonymChars = '<>' 365 TabOrder = 3 366 OnChange = cboCategoryChange 367 CharsNeedMatch = 1 368 end 369 object chkPreOp: TCheckBox 370 Left = 146 371 Top = 233 372 Width = 61 373 Height = 17 374 Caption = 'Pre-Op' 375 TabOrder = 9 376 Visible = False 377 OnClick = ControlChange 378 end 379 object cboSubmit: TORComboBox 380 Left = 154 381 Top = 57 382 Width = 142 383 Height = 21 384 Style = orcsDropDown 385 AutoSelect = True 386 Caption = 'Submit To' 387 Color = clWindow 388 DropDownCount = 8 389 ItemHeight = 13 390 ItemTipColor = clWindow 391 ItemTipEnable = True 392 ListItemsOnly = True 393 LongList = False 394 LookupPiece = 0 395 MaxLength = 0 396 Pieces = '2' 397 Sorted = False 398 SynonymChars = '<>' 399 TabOrder = 4 400 OnChange = ControlChange 401 CharsNeedMatch = 1 402 end 403 object lstLastExam: TORListBox 404 Left = 4 405 Top = 95 406 Width = 187 407 Height = 98 408 Color = clBtnFace 409 ExtendedSelect = False 410 ItemHeight = 13 411 MultiSelect = True 412 ParentShowHint = False 413 ShowHint = True 414 TabOrder = 5 415 Caption = 'Exams Over the Last 7 Days' 416 ItemTipColor = clWindow 417 LongList = False 418 Pieces = '2' 419 end 420 object grpPregnant: TGroupBox 421 Left = 196 422 Top = 112 423 Width = 158 424 Height = 41 425 Caption = 'Pregnant' 426 TabOrder = 7 427 object radPregnant: TRadioButton 428 Left = 2 429 Top = 17 430 Width = 39 431 Height = 17 432 Caption = 'Yes' 433 TabOrder = 0 434 OnClick = ControlChange 435 end 436 object radPregnantNo: TRadioButton 437 Left = 47 438 Top = 17 439 Width = 35 440 Height = 17 441 Caption = 'No' 442 TabOrder = 1 443 OnClick = ControlChange 444 end 445 object radPregnantUnknown: TRadioButton 446 Left = 87 447 Top = 16 448 Width = 66 449 Height = 17 450 Caption = 'Unknown' 451 TabOrder = 2 452 OnClick = ControlChange 453 end 454 end 455 end 456 object pnlHandR: TPanel 457 Left = 0 445 458 Top = 0 446 Width = 125 447 Height = 13 448 Caption = 'History && Reason for Exam' 449 end 450 object memReason: TCaptionMemo 451 Left = 3 452 Top = 15 453 Width = 346 454 Height = 68 455 Anchors = [akLeft, akTop, akRight, akBottom] 456 ScrollBars = ssVertical 459 Width = 362 460 Height = 127 461 Align = alClient 462 BevelOuter = bvNone 457 463 TabOrder = 0 458 OnChange = ControlChange 459 OnExit = memReasonExit 460 Caption = 'History && Reason for Exam' 461 end 462 end 463 inherited cmdAccept: TButton 464 Left = 487 465 Top = 283 464 object lblHistory: TLabel 465 Left = 0 466 Top = 34 467 Width = 362 468 Height = 13 469 Align = alTop 470 Caption = 'Clinical History (Optional)' 471 ExplicitWidth = 116 472 end 473 object lblReason: TLabel 474 Left = 0 475 Top = 0 476 Width = 362 477 Height = 13 478 Align = alTop 479 Caption = 'Reason for Study (REQUIRED - 64 characters maximum)' 480 ExplicitWidth = 268 481 end 482 object memHistory: TCaptionMemo 483 Left = 0 484 Top = 47 485 Width = 362 486 Height = 80 487 Align = alClient 488 ScrollBars = ssVertical 489 TabOrder = 3 490 OnChange = ControlChange 491 OnExit = memHistoryExit 492 Caption = 'Clinical History (Optional)' 493 end 494 object txtReason: TCaptionEdit 495 Left = 0 496 Top = 13 497 Width = 362 498 Height = 21 499 Align = alTop 500 MaxLength = 64 501 TabOrder = 0 502 OnChange = ControlChange 503 Caption = 'Reason for Study (REQUIRED)' 504 end 505 end 506 end 507 inherited cmdQuit: TButton 508 Left = 498 509 Top = 353 466 510 Anchors = [akRight, akBottom] 467 511 TabOrder = 4 468 end 469 inherited cmdQuit: TButton 470 Left = 488 471 Top = 310 472 Anchors = [akRight, akBottom] 473 TabOrder = 5 512 ExplicitLeft = 498 513 ExplicitTop = 353 474 514 end 475 515 inherited pnlMessage: TPanel 476 Left = 13477 Top = 262516 Left = 5 517 Top = 318 478 518 Width = 408 479 519 Height = 55 480 TabOrder = 1 520 TabOrder = 2 521 ExplicitLeft = 5 522 ExplicitTop = 318 523 ExplicitWidth = 408 524 ExplicitHeight = 55 481 525 inherited imgMessage: TImage 482 526 Left = 10 483 527 Top = 9 528 ExplicitLeft = 10 529 ExplicitTop = 9 484 530 end 485 531 inherited memMessage: TRichEdit … … 487 533 Width = 344 488 534 Height = 43 489 end 535 ExplicitLeft = 55 536 ExplicitWidth = 344 537 ExplicitHeight = 43 538 end 539 end 540 inherited amgrMain: TVA508AccessibilityManager 541 Data = ( 542 ( 543 'Component = FRadCommonCombo' 544 'Status = stsDefault') 545 ( 546 'Component = pnlLeft' 547 'Status = stsDefault') 548 ( 549 'Component = cboImType' 550 'Status = stsDefault') 551 ( 552 'Component = lstSelectMod' 553 'Status = stsDefault') 554 ( 555 'Component = cboProcedure' 556 'Status = stsDefault') 557 ( 558 'Component = cboAvailMod' 559 'Status = stsDefault') 560 ( 561 'Component = cmdRemove' 562 'Status = stsDefault') 563 ( 564 'Component = pnlRightBase' 565 'Status = stsDefault') 566 ( 567 'Component = pnlRight' 568 'Status = stsDefault') 569 ( 570 'Component = calPreOp' 571 'Status = stsDefault') 572 ( 573 'Component = chkIsolation' 574 'Status = stsDefault') 575 ( 576 'Component = calRequestDate' 577 'Status = stsDefault') 578 ( 579 'Component = cboUrgency' 580 'Status = stsDefault') 581 ( 582 'Component = cboTransport' 583 'Status = stsDefault') 584 ( 585 'Component = cboCategory' 586 'Status = stsDefault') 587 ( 588 'Component = chkPreOp' 589 'Status = stsDefault') 590 ( 591 'Component = cboSubmit' 592 'Status = stsDefault') 593 ( 594 'Component = lstLastExam' 595 'Status = stsDefault') 596 ( 597 'Component = grpPregnant' 598 'Status = stsDefault') 599 ( 600 'Component = radPregnant' 601 'Status = stsDefault') 602 ( 603 'Component = radPregnantNo' 604 'Status = stsDefault') 605 ( 606 'Component = radPregnantUnknown' 607 'Status = stsDefault') 608 ( 609 'Component = pnlHandR' 610 'Status = stsDefault') 611 ( 612 'Component = memHistory' 613 'Status = stsDefault') 614 ( 615 'Component = txtReason' 616 'Status = stsDefault') 617 ( 618 'Component = memOrder' 619 'Status = stsDefault') 620 ( 621 'Component = cmdAccept' 622 'Status = stsDefault') 623 ( 624 'Component = cmdQuit' 625 'Status = stsDefault') 626 ( 627 'Component = pnlMessage' 628 'Status = stsDefault') 629 ( 630 'Component = memMessage' 631 'Status = stsDefault') 632 ( 633 'Component = frmODRad' 634 'Status = stsDefault')) 490 635 end 491 636 end -
cprs/trunk/CPRS-Chart/Orders/fODRad.pas
r456 r829 6 6 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 7 7 Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls, 8 ComCtrls, uConst, ORDtTm ;8 ComCtrls, uConst, ORDtTm, VA508AccessibilityManager; 9 9 10 10 type … … 22 22 cboSubmit: TORComboBox; 23 23 lstLastExam: TORListBox; 24 lbl Reason: TLabel;25 mem Reason: TCaptionMemo;24 lblHistory: TLabel; 25 memHistory: TCaptionMemo; 26 26 lstSelectMod: TORListBox; 27 27 lblSelectMod: TLabel; … … 46 46 radPregnantNo: TRadioButton; 47 47 radPregnantUnknown: TRadioButton; 48 lblReason: TLabel; 49 txtReason: TCaptionEdit; 50 pnlRightBase: TORAutoPanel; 48 51 procedure cboProcedureNeedData(Sender: TObject; 49 52 const StartFrom: string; Direction, InsertAt: Integer); … … 56 59 procedure FormCreate(Sender: TObject); 57 60 procedure cboImTypeChange(Sender: TObject); 58 procedure mem ReasonExit(Sender: TObject);61 procedure memHistoryExit(Sender: TObject); 59 62 procedure FormResize(Sender: TObject); 60 63 procedure cboAvailModKeyDown(Sender: TObject; var Key: Word; … … 97 100 TX_NO_PROC = 'An Imaging Procedure must be specified.' ; 98 101 TX_NO_MODE = 'A mode of transport must be selected.'; 99 TX_NO_REASON = 'A History & Reason for Exam must be entered.' ; 100 TX_NO_DATE = 'Unable to evaluate request date.' ; 102 TX_NO_REASON = 'A Reason for Study must be entered.' ; 103 TX_BAD_HISTORY = 'An incomplete or invalid Clinical History has been entered.' + CRLF + 104 'Please correct or clear.'; 105 TX_NO_DATE = 'A "Date Desired" must be specified.' ; 106 TX_BAD_DATE = 'The "Date Desired" you have entered is invalid.'; 107 TX_PAST_DATE = '"Date Desired" must not be in the past.'; 101 108 TX_APPROVAL_REQUIRED= 'This procedure requires Radiologist approval.' ; 102 109 TX_NO_SOURCE = 'A source must be specified for Contract/Sharing/Research patients.'; … … 131 138 with cboImType do 132 139 begin 133 Items.Assign(SubsetOfImagingTypes);140 FastAssign(SubsetOfImagingTypes, cboImType.Items); 134 141 for i := 0 to Items.Count-1 do 135 142 if StrToIntDef(Piece(Items[i],U,4), 0) = DisplayGroup then ItemIndex := i; … … 151 158 SetControl(cboSubmit, 'IMLOC', 1); 152 159 SetControl(cboCategory, 'CLASS', 1); 153 SetControl(memReason, 'COMMENT', 1); 160 SetControl(txtReason, 'REASON', 1); 161 SetControl(memHistory, 'COMMENT', 1); 154 162 SetControl(chkIsolation, 'YN', 1); 155 163 SetControl(radPregnant, 'PREGNANT', 1); … … 214 222 tmplst: TStringList; 215 223 begin 216 if not FEditCopy then inherited; 224 if not FEditCopy then 225 begin 226 inherited; 227 if not ReasonForStudyCarryOn then txtReason.text := ''; 228 end; 217 229 218 230 FPreOpDate := ''; … … 236 248 if FRadCommonCombo.Items.Count>0 then cboProcedure.InsertSeparator; 237 249 238 calRequestDate.Text := 'TODAY';250 //calRequestDate.Text := 'TODAY'; default removed per E3R #19834 - v27.10 - RV 239 251 SetControl(cboAvailMod, 'Modifiers'); 240 252 SetControl(cboUrgency, 'Urgencies'); … … 262 274 tmplst := TStringList.Create; 263 275 try 264 tmplst.Assign(cboSubmit.Items);276 FastAssign(cboSubmit.Items, tmplst); 265 277 SortByPiece(tmplst, U, 2); 266 cboSubmit.Items.Assign(tmplst);278 FastAssign(tmplst, cboSubmit.Items); 267 279 finally 268 280 tmplst.Free; … … 299 311 cboProcedure.InitLongList('') ; 300 312 StatusText(''); 313 301 314 end; 302 315 … … 326 339 else Responses.Update('YN', 1, '0' , 'No'); 327 340 with calPreOp do if Length(Text) > 0 then Responses.Update('PREOP', 1, FPreOpDate, Text); 328 with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text); 341 with txtReason do if GetTextLen > 0 then Responses.Update('REASON', 1, Text, Text); 342 with memHistory do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text); 329 343 with lstSelectMod do for i := 0 to Items.Count - 1 do 330 344 Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2)); … … 380 394 end ; 381 395 end; 396 397 if Length(txtReason.Text) < 3 then 398 SetError(TX_NO_REASON) 399 else 400 begin 401 j := 0; 402 for i := 1 to Length(txtReason.Text) do 403 begin 404 if txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1; 405 if not (txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0; 406 if j = 2 then break; 407 end; 408 if j < 2 then SetError(TX_NO_REASON); 409 end; 410 411 if Length(memHistory.Text) > 0 then 412 begin 413 j := 0; 414 for i := 1 to Length(memHistory.Text) do 415 begin 416 if memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1; 417 if not (memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0; 418 if j = 2 then break; 419 end; 420 if j < 2 then SetError(TX_BAD_HISTORY); 421 end; 422 382 423 with cboCategory do 383 424 begin 384 AskLoc := True;425 AskLoc := (ALocation = 0); 385 426 if ((not Patient.Inpatient) and (Self.EvtType = 'A')) then 386 427 AskLoc := False; … … 401 442 if Length(cboTransport.Text) = 0 then SetError(TX_NO_MODE); 402 443 403 if Length(memReason.Text) < 2 then404 SetError(TX_NO_REASON)405 else406 begin407 j := 0;408 for i := 1 to Length(memReason.Text) do409 begin410 if memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;411 if not (memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;412 if j = 2 then break;413 end;414 if j < 2 then SetError(TX_NO_REASON);415 end;416 417 444 with cboSubmit do 418 445 if Enabled and (ItemIEN = 0)then SetError(TX_NO_IMAGING_LOCATION); 419 446 420 447 with calRequestDate do 421 if FMDateTime = 0 then SetError(TX_NO_DATE); 448 begin 449 if FMDateTime = 0 then 450 SetError(TX_NO_DATE) 451 else if FMDateTime < 0 then 452 SetError(TX_BAD_DATE) 453 else if FMDateTime < FMToday then 454 SetError(TX_PAST_DATE); 455 end; 422 456 423 457 end; … … 492 526 ClearControl(lstSelectMod); 493 527 ClearControl(lstLastExam); 494 //ClearControl(mem Reason); {WPB-1298-30758}528 //ClearControl(memHistory); {WPB-1298-30758} 495 529 Changing := False; 496 530 if CharAt(ItemID, 1) = 'Q' then … … 513 547 SetControl(cboTransport, 'MODE', 1); 514 548 SetControl(cboCategory, 'CLASS', 1); 515 SetControl(memReason, 'COMMENT', 1); 549 SetControl(txtReason, 'REASON', 1); 550 SetControl(memHistory, 'COMMENT', 1); 516 551 SetControl(chkIsolation, 'YN', 1); 517 552 SetControl(radPregnant, 'PREGNANT', 1); … … 581 616 AutoSizeDisabled := True; 582 617 inherited; 583 mem Reason.Width := pnlHandR.ClientWidth;584 mem Reason.Height := pnlHandR.ClientHeight - memReason.Top;618 memHistory.Width := pnlHandR.ClientWidth; 619 memHistory.Height := pnlHandR.ClientHeight - memHistory.Top; 585 620 FillerID := 'RA'; // does 'on Display' order check **KCM** 586 621 StatusText('Loading Dialog Definition'); … … 590 625 Responses.Dialog := 'RA OERR EXAM'; // loads formatting info 591 626 StatusText('Loading Default Values'); 592 cboImType.Items.Assign(SubsetOfImagingTypes);627 FastAssign(SubsetOfImagingTypes, cboImType.Items); 593 628 if Self.EvtID>0 then 594 629 FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID)); … … 600 635 PreserveControl(cboCategory); 601 636 PreserveControl(calPreOp); 602 PreserveControl(memReason); {WPB-1298-30758} 637 PreserveControl(txtReason); 638 PreserveControl(memHistory); {WPB-1298-30758} 603 639 if (Patient.Sex <> 'F') then 604 640 begin … … 619 655 end; 620 656 621 procedure TfrmODRad.mem ReasonExit(Sender: TObject);657 procedure TfrmODRad.memHistoryExit(Sender: TObject); 622 658 var 623 659 AStringList: TStringList; … … 626 662 AStringList := TStringList.Create; 627 663 try 628 AStringList.Assign(memReason.Lines);664 FastAssign(memHistory.Lines, AStringList); 629 665 LimitStringLength(AStringList, 74); 630 memReason.Lines.Assign(AstringList);666 FastAssign(AstringList, memHistory.Lines); 631 667 ControlChange(Self); 632 668 finally … … 638 674 begin 639 675 inherited; 640 mem Reason.Width := pnlHandR.ClientWidth;641 mem Reason.Height := pnlHandR.ClientHeight - memReason.Top;676 memHistory.Width := pnlHandR.ClientWidth; 677 memHistory.Height := pnlHandR.ClientHeight - memHistory.Top; 642 678 end; 643 679 -
cprs/trunk/CPRS-Chart/Orders/fODRadApproval.dfm
r456 r829 1 objectfrmODRadApproval: TfrmODRadApproval1 inherited frmODRadApproval: TfrmODRadApproval 2 2 Left = 295 3 3 Top = 167 … … 6 6 ClientHeight = 262 7 7 ClientWidth = 259 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 … … 68 62 ListItemsOnly = True 69 63 LongList = False 64 LookupPiece = 0 70 65 MaxLength = 0 71 66 Pieces = '2' … … 73 68 SynonymChars = '<>' 74 69 TabOrder = 0 70 CharsNeedMatch = 1 75 71 end 76 72 end 73 inherited amgrMain: TVA508AccessibilityManager 74 Data = ( 75 ( 76 'Component = pnlBase' 77 'Status = stsDefault') 78 ( 79 'Component = cmdOK' 80 'Status = stsDefault') 81 ( 82 'Component = cmdCancel' 83 'Status = stsDefault') 84 ( 85 'Component = cboRadiologist' 86 'Status = stsDefault') 87 ( 88 'Component = frmODRadApproval' 89 'Status = stsDefault')) 90 end 77 91 end -
cprs/trunk/CPRS-Chart/Orders/fODRadApproval.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 TfrmODRadApproval = class(T Form)9 TfrmODRadApproval = class(TfrmBase508Form) 10 10 cmdOK: TButton; 11 11 cmdCancel: TButton; … … 49 49 ClientHeight := H; pnlBase.Height := H; 50 50 FChanged := False; 51 cboRadiologist.Items.Assign(SubsetOfRadiologists);51 FastAssign(SubsetOfRadiologists, cboRadiologist.Items); 52 52 ShowModal; 53 53 Radiologist := FRadiologist ; -
cprs/trunk/CPRS-Chart/Orders/fODRadConShRes.dfm
r456 r829 1 objectfrmODRadConShRes: TfrmODRadConShRes1 inherited frmODRadConShRes: TfrmODRadConShRes 2 2 Left = 308 3 3 Top = 206 … … 7 7 ClientHeight = 121 8 8 ClientWidth = 288 9 Color = clBtnFace10 Font.Charset = DEFAULT_CHARSET11 Font.Color = clWindowText12 Font.Height = -1113 Font.Name = 'MS Sans Serif'14 Font.Style = []15 9 OldCreateOrder = True 16 10 Position = poScreenCenter 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 … … 69 63 ListItemsOnly = True 70 64 LongList = False 65 LookupPiece = 0 71 66 MaxLength = 0 72 67 Pieces = '2' … … 74 69 SynonymChars = '<>' 75 70 TabOrder = 0 71 CharsNeedMatch = 1 76 72 end 77 73 object txtResearch: TCaptionEdit … … 85 81 end 86 82 end 83 inherited amgrMain: TVA508AccessibilityManager 84 Data = ( 85 ( 86 'Component = pnlBase' 87 'Status = stsDefault') 88 ( 89 'Component = cmdOK' 90 'Status = stsDefault') 91 ( 92 'Component = cmdCancel' 93 'Status = stsDefault') 94 ( 95 'Component = cboSource' 96 'Status = stsDefault') 97 ( 98 'Component = txtResearch' 99 'Status = stsDefault') 100 ( 101 'Component = frmODRadConShRes' 102 'Status = stsDefault')) 103 end 87 104 end -
cprs/trunk/CPRS-Chart/Orders/fODRadConShRes.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 TfrmODRadConShRes = class(T Form)9 TfrmODRadConShRes = class(TfrmBase508Form) 10 10 cmdOK: TButton; 11 11 cmdCancel: TButton; … … 54 54 if SrcType in ['C','S'] then with cboSource do 55 55 begin 56 Items.Assign(SubsetOfRadSources(SrcType));56 FastAssign(SubsetOfRadSources(SrcType), cboSource.Items); 57 57 if Items.Count > 0 then 58 58 begin -
cprs/trunk/CPRS-Chart/Orders/fODRadImType.dfm
r456 r829 1 objectfrmODRadImType: TfrmODRadImType1 inherited frmODRadImType: TfrmODRadImType 2 2 Left = 308 3 3 Top = 206 … … 6 6 ClientHeight = 189 7 7 ClientWidth = 259 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' … … 75 70 TabOrder = 0 76 71 OnDblClick = cboImTypeDblClick 72 CharsNeedMatch = 1 77 73 end 78 74 end 75 inherited amgrMain: TVA508AccessibilityManager 76 Data = ( 77 ( 78 'Component = pnlBase' 79 'Status = stsDefault') 80 ( 81 'Component = cmdOK' 82 'Status = stsDefault') 83 ( 84 'Component = cmdCancel' 85 'Status = stsDefault') 86 ( 87 'Component = cboImType' 88 'Status = stsDefault') 89 ( 90 'Component = frmODRadImType' 91 'Status = stsDefault')) 92 end 79 93 end -
cprs/trunk/CPRS-Chart/Orders/fODRadImType.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 TfrmODRadImType = class(T Form)9 TfrmODRadImType = class(TfrmBase508Form) 10 10 cmdOK: TButton; 11 11 cmdCancel: TButton; … … 50 50 ClientHeight := H; pnlBase.Height := H; 51 51 FChanged := False; 52 cboImType.Items.Assign(SubsetOfImagingTypes);52 FastAssign(SubsetOfImagingTypes, cboImType.Items); 53 53 if cboImType.Items.Count > 1 then 54 54 ShowModal -
cprs/trunk/CPRS-Chart/Orders/fODReleaseEvent.dfm
r456 r829 1 objectfrmOrdersReleaseEvent: TfrmOrdersReleaseEvent1 inherited frmOrdersReleaseEvent: TfrmOrdersReleaseEvent 2 2 Left = 410 3 3 Top = 145 4 Width = 4945 Height = 4886 4 Caption = 'Release to Service' 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 OldCreateOrder = False 5 ClientHeight = 461 6 ClientWidth = 486 14 7 Position = poScreenCenter 15 8 OnCreate = FormCreate 16 9 OnDestroy = FormDestroy 10 ExplicitWidth = 494 11 ExplicitHeight = 488 17 12 PixelsPerInch = 96 18 13 TextHeight = 13 19 object lblRelease: TLabel 14 object lblRelease: TLabel [0] 20 15 Left = 0 21 16 Top = 0 … … 25 20 Layout = tlCenter 26 21 WordWrap = True 22 ExplicitWidth = 3 27 23 end 28 object pnlMiddle: TPanel 24 object pnlMiddle: TPanel [1] 29 25 Left = 0 30 26 Top = 13 … … 49 45 end 50 46 end 51 object pnlBottom: TPanel 47 object pnlBottom: TPanel [2] 52 48 Left = 0 53 49 Top = 426 … … 81 77 end 82 78 end 79 inherited amgrMain: TVA508AccessibilityManager 80 Data = ( 81 ( 82 'Component = pnlMiddle' 83 'Status = stsDefault') 84 ( 85 'Component = cklstOrders' 86 'Status = stsDefault') 87 ( 88 'Component = pnlBottom' 89 'Status = stsDefault') 90 ( 91 'Component = btnOK' 92 'Status = stsDefault') 93 ( 94 'Component = btnCancel' 95 'Status = stsDefault') 96 ( 97 'Component = frmOrdersReleaseEvent' 98 'Status = stsDefault')) 99 end 83 100 end -
cprs/trunk/CPRS-Chart/Orders/fODReleaseEvent.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz; 7 StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmOrdersReleaseEvent = class(T Form)11 TfrmOrdersReleaseEvent = class(TfrmBase508Form) 11 12 pnlMiddle: TPanel; 12 13 pnlBottom: TPanel; … … 44 45 {$R *.DFM} 45 46 46 uses rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, fOrders; 47 uses rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, fOrders, rODLab, fRptBox, 48 VAUtils; 49 47 50 const 48 51 TX_SAVERR1 = 'The error, '; … … 60 63 OrderText, LastCheckedPtEvt, SpeCap: string; 61 64 frmOrdersReleaseEvent: TfrmOrdersReleaseEvent; 65 AList: TStringList; 62 66 63 67 function FindOrderText(const AnID: string): string; … … 119 123 begin 120 124 OrderText := FindOrderText(Piece(OrdersLst[i], U, 1)); 121 InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,TC_SAVERR, MB_OK); 125 if Piece(OrdersLst[i],U,4) = 'Invalid Pharmacy order number' then 126 InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF + 127 'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.', 128 TC_SAVERR, MB_OK) 129 else 130 InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText, 131 TC_SAVERR, MB_OK); 122 132 end; 133 end; 134 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders 135 AList := TStringList.Create; 136 try 137 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, OrdersLst); 138 if AList.Text <> '' then 139 ReportBox(AList, 'Changed Orders', TRUE); 140 finally 141 AList.Free; 123 142 end; 124 143 PrintOrdersOnSignRelease(OrdersLst, NO_PROVIDER); … … 194 213 if not beSelected then 195 214 begin 196 ShowM essage('You have to select at least one order!');215 ShowMsg('You have to select at least one order!'); 197 216 Exit; 198 217 end; … … 238 257 begin 239 258 Canvas.FillRect(ARect); 240 Canvas.Pen.Color := clSilver;259 Canvas.Pen.Color := Get508CompliantColor(clSilver); 241 260 Canvas.MoveTo(0, ARect.Bottom - 1); 242 261 Canvas.LineTo(ARect.Right, ARect.Bottom - 1); -
cprs/trunk/CPRS-Chart/Orders/fODSaveQuick.dfm
r456 r829 2 2 Left = 371 3 3 Top = 203 4 Width = 3045 Height = 2906 4 Caption = 'frmODQuick' 5 ClientHeight = 263 6 ClientWidth = 296 7 ExplicitWidth = 304 8 ExplicitHeight = 290 7 9 PixelsPerInch = 96 8 10 TextHeight = 13 9 object Label1: TLabel 11 object Label1: TLabel [0] 10 12 Left = 8 11 13 Top = 8 … … 14 16 Caption = 'Enter the name that should be used for this quick order.' 15 17 end 16 object Label2: TLabel 18 object Label2: TLabel [1] 17 19 Left = 8 18 20 Top = 61 … … 21 23 Caption = 'Meds, Inpatient Common List' 22 24 end 23 object SpeedButton1: TSpeedButton 25 object SpeedButton1: TSpeedButton [2] 24 26 Left = 263 25 27 Top = 108 … … 36 38 33333333333C3333333333333333333333333333333333333333} 37 39 end 38 object SpeedButton2: TSpeedButton 40 object SpeedButton2: TSpeedButton [3] 39 41 Left = 263 40 42 Top = 144 … … 51 53 333333333CCCCC33333333333333333333333333333333333333} 52 54 end 53 object Bevel1: TBevel 55 object Bevel1: TBevel [4] 54 56 Left = 8 55 57 Top = 224 … … 57 59 Height = 2 58 60 end 59 object Bevel2: TBevel 61 object Bevel2: TBevel [5] 60 62 Left = 8 61 63 Top = 51 … … 63 65 Height = 2 64 66 end 65 object Edit1: TCaptionEdit 67 object Edit1: TCaptionEdit [6] 66 68 Left = 8 67 69 Top = 22 … … 71 73 Caption = 'Enter the name that should be used for this quick order.' 72 74 end 73 object ORListBox1: TORListBox 75 object ORListBox1: TORListBox [7] 74 76 Left = 8 75 77 Top = 75 … … 83 85 LongList = False 84 86 end 85 object Button1: TButton 87 object Button1: TButton [8] 86 88 Left = 136 87 89 Top = 234 … … 91 93 TabOrder = 2 92 94 end 93 object Button2: TButton 95 object Button2: TButton [9] 94 96 Left = 216 95 97 Top = 234 … … 99 101 TabOrder = 3 100 102 end 101 object BitBtn1: TBitBtn 103 object BitBtn1: TBitBtn [10] 102 104 Left = 263 103 105 Top = 191 … … 107 109 Kind = bkAbort 108 110 end 111 inherited amgrMain: TVA508AccessibilityManager 112 Data = ( 113 ( 114 'Component = Edit1' 115 'Status = stsDefault') 116 ( 117 'Component = ORListBox1' 118 'Status = stsDefault') 119 ( 120 'Component = Button1' 121 'Status = stsDefault') 122 ( 123 'Component = Button2' 124 'Status = stsDefault') 125 ( 126 'Component = BitBtn1' 127 'Status = stsDefault') 128 ( 129 'Component = frmODQuick' 130 'Status = stsDefault')) 131 end 109 132 end -
cprs/trunk/CPRS-Chart/Orders/fODSaveQuick.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls ;7 fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fODText.dfm
r456 r829 24 24 Caption = 'Stop Date/Time' 25 25 end 26 inherited memOrder: T Memo26 inherited memOrder: TCaptionMemo 27 27 TabOrder = 6 28 28 end … … 30 30 TabOrder = 3 31 31 end 32 inherited cmdQuit: TButton 33 TabOrder = 4 34 end 35 object memText: TMemo [6] 32 object memText: TMemo [5] 36 33 Left = 6 37 34 Top = 18 … … 41 38 OnChange = ControlChange 42 39 end 43 object txtStart: TORDateBox [ 7]40 object txtStart: TORDateBox [6] 44 41 Left = 226 45 42 Top = 164 … … 52 49 Caption = 'Start Date/Time' 53 50 end 54 object txtStop: TORDateBox [ 8]51 object txtStop: TORDateBox [7] 55 52 Left = 374 56 53 Top = 164 … … 63 60 Caption = 'Stop Date/Time' 64 61 end 62 inherited cmdQuit: TButton 63 TabOrder = 4 64 end 65 65 inherited pnlMessage: TPanel 66 66 TabOrder = 5 67 67 end 68 inherited amgrMain: TVA508AccessibilityManager 69 Data = ( 70 ( 71 'Component = memText' 72 'Status = stsDefault') 73 ( 74 'Component = txtStart' 75 'Status = stsDefault') 76 ( 77 'Component = txtStop' 78 'Status = stsDefault') 79 ( 80 'Component = memOrder' 81 'Status = stsDefault') 82 ( 83 'Component = cmdAccept' 84 'Status = stsDefault') 85 ( 86 'Component = cmdQuit' 87 'Status = stsDefault') 88 ( 89 'Component = pnlMessage' 90 'Status = stsDefault') 91 ( 92 'Component = memMessage' 93 'Status = stsDefault') 94 ( 95 'Component = frmODText' 96 'Status = stsDefault')) 97 end 68 98 end -
cprs/trunk/CPRS-Chart/Orders/fODText.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm; 7 fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm, 8 VA508AccessibilityManager; 8 9 9 10 type … … 17 18 procedure FormCreate(Sender: TObject); 18 19 procedure ControlChange(Sender: TObject); 20 procedure cmdAcceptClick(Sender: TObject); 19 21 public 20 22 procedure InitDialog; override; … … 45 47 FillerID := 'OR'; // does 'on Display' order check **KCM** 46 48 StatusText('Loading Dialog Definition'); 47 Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDE '; // loads formatting info49 Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDER'; // loads formatting info 48 50 //StatusText('Loading Default Values'); // there are no defaults for text only 49 51 //CtrlInits.LoadDefaults(ODForText); … … 110 112 end; 111 113 114 procedure TfrmODText.cmdAcceptClick(Sender: TObject); 115 begin 116 inherited; 117 Application.ProcessMessages; //CQ 14670 118 memText.Lines.Text := Trim(memText.Lines.Text); //CQ 14670 119 end; 120 112 121 procedure TfrmODText.ControlChange(Sender: TObject); 113 122 begin -
cprs/trunk/CPRS-Chart/Orders/fODValidateAction.dfm
r456 r829 1 objectfrmInvalidActionList: TfrmInvalidActionList1 inherited frmInvalidActionList: TfrmInvalidActionList 2 2 Left = 445 3 3 Top = 142 4 Width = 5345 Height = 5536 4 Caption = 'Invalidated action orders' 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 OldCreateOrder = False 5 ClientHeight = 519 6 ClientWidth = 526 14 7 Position = poScreenCenter 15 8 OnCreate = FormCreate … … 17 10 PixelsPerInch = 96 18 11 TextHeight = 13 19 object pnlTop: TPanel 12 object pnlTop: TPanel [0] 20 13 Left = 0 21 14 Top = 0 … … 38 31 Width = 524 39 32 Height = 176 33 Style = lbOwnerDrawVariable 40 34 Align = alClient 41 35 ItemHeight = 16 42 Style = lbOwnerDrawVariable43 36 TabOrder = 0 44 37 OnDrawItem = lstActDeniedOrdersDrawItem … … 51 44 Width = 524 52 45 Height = 27 53 DragReorder = False54 46 Sections = < 55 47 item … … 68 60 end 69 61 end 70 object pnlBottom: TPanel 62 object pnlBottom: TPanel [1] 71 63 Left = 0 72 64 Top = 229 73 65 Width = 526 74 Height = 2 5666 Height = 249 75 67 Align = alClient 76 68 TabOrder = 1 69 ExplicitHeight = 256 77 70 object Label2: TLabel 78 71 Left = 1 … … 95 88 Top = 41 96 89 Width = 524 97 Height = 214 90 Height = 207 91 Style = lbOwnerDrawVariable 98 92 Align = alClient 99 93 ItemHeight = 16 100 Style = lbOwnerDrawVariable101 94 TabOrder = 0 102 95 OnDrawItem = lstValidOrdersDrawItem … … 105 98 end 106 99 end 107 object Panel1: TPanel 100 object Panel1: TPanel [2] 108 101 Left = 0 109 Top = 4 85102 Top = 478 110 103 Width = 526 111 104 Height = 41 112 105 Align = alBottom 113 106 TabOrder = 2 107 ExplicitTop = 485 108 DesignSize = ( 109 526 110 41) 114 111 object btnOK: TButton 115 112 Left = 440 … … 123 120 end 124 121 end 122 inherited amgrMain: TVA508AccessibilityManager 123 Data = ( 124 ( 125 'Component = pnlTop' 126 'Status = stsDefault') 127 ( 128 'Component = lstActDeniedOrders' 129 'Status = stsDefault') 130 ( 131 'Component = hdrAction' 132 'Status = stsDefault') 133 ( 134 'Component = pnlBottom' 135 'Status = stsDefault') 136 ( 137 'Component = lstValidOrders' 138 'Status = stsDefault') 139 ( 140 'Component = Panel1' 141 'Status = stsDefault') 142 ( 143 'Component = btnOK' 144 'Status = stsDefault') 145 ( 146 'Component = frmInvalidActionList' 147 'Status = stsDefault')) 148 end 125 149 end -
cprs/trunk/CPRS-Chart/Orders/fODValidateAction.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,uConst, ORCtrls; 7 ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,uConst, ORCtrls, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmInvalidActionList = class(T Form)11 TfrmInvalidActionList = class(TfrmBase508Form) 11 12 pnlTop: TPanel; 12 13 lstActDeniedOrders: TCaptionListBox; … … 43 44 implementation 44 45 46 uses 47 VA2006Utils; 48 45 49 {$R *.DFM} 46 50 … … 97 101 ARect := TheRect; 98 102 Canvas.FillRect(ARect); 99 Canvas.Pen.Color := clSilver;103 Canvas.Pen.Color := Get508CompliantColor(clSilver); 100 104 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); 101 105 Canvas.LineTo(ARect.Right, ARect.Bottom - 1); … … 168 172 procedure TfrmInvalidActionList.FormCreate(Sender: TObject); 169 173 begin 174 FixHeaderControlDelphi2006Bug(hdrAction); 170 175 TheInvaList := TStringList.Create; 171 176 end; … … 234 239 ARect := TheRect; 235 240 Canvas.FillRect(ARect); 236 Canvas.Pen.Color := clSilver;241 Canvas.Pen.Color := Get508CompliantColor(clSilver); 237 242 SaveColor := Canvas.Brush.Color; 238 243 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); -
cprs/trunk/CPRS-Chart/Orders/fODVitals.dfm
r456 r829 49 49 Caption = 'Additional Instructions' 50 50 end 51 object cboMeasurement: TORComboBox 51 object cboMeasurement: TORComboBox [10] 52 52 Left = 6 53 53 Top = 21 … … 73 73 CharsNeedMatch = 1 74 74 end 75 object cboSchedule: TORComboBox 75 object cboSchedule: TORComboBox [11] 76 76 Left = 144 77 77 Top = 21 … … 97 97 CharsNeedMatch = 1 98 98 end 99 object calStart: TORDateBox 99 object calStart: TORDateBox [12] 100 100 Left = 282 101 101 Top = 21 … … 109 109 Caption = 'Start Date' 110 110 end 111 object calStop: TORDateBox 111 object calStop: TORDateBox [13] 112 112 Left = 282 113 113 Top = 64 … … 120 120 Caption = 'Stop Date' 121 121 end 122 object grpCallHO: TGroupBox 122 object grpCallHO: TGroupBox [14] 123 123 Left = 407 124 124 Top = 9 … … 223 223 Height = 21 224 224 Associate = txtBPsys 225 Min = 0226 225 Max = 300 227 226 Position = 100 228 227 TabOrder = 5 229 Wrap = False230 228 end 231 229 object spnBPdia: TUpDown … … 235 233 Height = 21 236 234 Associate = txtBPDia 237 Min = 0238 235 Max = 300 239 236 Position = 120 240 237 TabOrder = 6 241 Wrap = False242 238 end 243 239 object spnPulseLT: TUpDown … … 247 243 Height = 21 248 244 Associate = txtPulseLT 249 Min = 0250 245 Max = 500 251 246 Position = 60 252 247 TabOrder = 7 253 Wrap = False254 248 end 255 249 object spnPulseGT: TUpDown … … 259 253 Height = 21 260 254 Associate = txtPulGT 261 Min = 0262 255 Max = 300 263 256 Position = 120 264 257 TabOrder = 8 265 Wrap = False266 258 end 267 259 object spnTemp: TUpDown … … 271 263 Height = 21 272 264 Associate = txtTemp 273 Min = 0274 265 Max = 120 275 266 Position = 101 276 267 TabOrder = 9 277 Wrap = False 278 end 279 end 280 object chkCallHO: TCheckBox 268 end 269 end 270 object chkCallHO: TCheckBox [15] 281 271 Left = 414 282 272 Top = 8 … … 287 277 Visible = False 288 278 end 279 inherited amgrMain: TVA508AccessibilityManager 280 Data = ( 281 ( 282 'Component = txtComment' 283 'Status = stsDefault') 284 ( 285 'Component = cboMeasurement' 286 'Status = stsDefault') 287 ( 288 'Component = cboSchedule' 289 'Status = stsDefault') 290 ( 291 'Component = calStart' 292 'Status = stsDefault') 293 ( 294 'Component = calStop' 295 'Status = stsDefault') 296 ( 297 'Component = grpCallHO' 298 'Status = stsDefault') 299 ( 300 'Component = txtBPsys' 301 'Status = stsDefault') 302 ( 303 'Component = txtBPDia' 304 'Status = stsDefault') 305 ( 306 'Component = txtPulseLT' 307 'Status = stsDefault') 308 ( 309 'Component = txtPulGT' 310 'Status = stsDefault') 311 ( 312 'Component = txtTemp' 313 'Status = stsDefault') 314 ( 315 'Component = spnBPsys' 316 'Status = stsDefault') 317 ( 318 'Component = spnBPdia' 319 'Status = stsDefault') 320 ( 321 'Component = spnPulseLT' 322 'Status = stsDefault') 323 ( 324 'Component = spnPulseGT' 325 'Status = stsDefault') 326 ( 327 'Component = spnTemp' 328 'Status = stsDefault') 329 ( 330 'Component = chkCallHO' 331 'Status = stsDefault') 332 ( 333 'Component = memOrder' 334 'Status = stsDefault') 335 ( 336 'Component = cmdAccept' 337 'Status = stsDefault') 338 ( 339 'Component = cmdQuit' 340 'Status = stsDefault') 341 ( 342 'Component = pnlMessage' 343 'Status = stsDefault') 344 ( 345 'Component = memMessage' 346 'Status = stsDefault') 347 ( 348 'Component = frmODVitals' 349 'Status = stsDefault')) 350 end 289 351 end -
cprs/trunk/CPRS-Chart/Orders/fODVitals.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fODBase, ComCtrls, ExtCtrls, StdCtrls, ORCtrls, ORDtTm; 7 fODBase, ComCtrls, ExtCtrls, StdCtrls, ORCtrls, ORDtTm, 8 VA508AccessibilityManager; 8 9 9 10 type -
cprs/trunk/CPRS-Chart/Orders/fOMAction.dfm
r456 r829 1 1 inherited frmOMAction: TfrmOMAction 2 2 Caption = 'frmOMAction' 3 ExplicitWidth = 320 4 ExplicitHeight = 240 3 5 PixelsPerInch = 96 4 6 TextHeight = 13 7 inherited amgrMain: TVA508AccessibilityManager 8 Data = ( 9 ( 10 'Component = frmOMAction' 11 'Status = stsDefault')) 12 end 5 13 end -
cprs/trunk/CPRS-Chart/Orders/fOMAction.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, rOrders ;7 fAutoSz, rOrders, VA508AccessibilityManager; 8 8 9 9 -
cprs/trunk/CPRS-Chart/Orders/fOMHTML.dfm
r456 r829 2 2 Left = 390 3 3 Top = 242 4 Width = 5205 Height = 3206 4 Caption = 'HTML Ordering' 5 ClientHeight = 293 6 ClientWidth = 512 7 7 OnClose = FormClose 8 8 OnCreate = FormCreate 9 ExplicitWidth = 520 10 ExplicitHeight = 320 9 11 PixelsPerInch = 96 10 12 TextHeight = 13 11 object btnOK: TButton 13 object btnOK: TButton [0] 12 14 Left = 352 13 15 Top = 268 … … 19 21 OnClick = btnOKClick 20 22 end 21 object btnCancel: TButton 23 object btnCancel: TButton [1] 22 24 Left = 433 23 25 Top = 268 … … 30 32 OnClick = btnCancelClick 31 33 end 32 object btnBack: TButton 34 object btnBack: TButton [2] 33 35 Left = 6 34 36 Top = 268 … … 41 43 OnClick = btnBackClick 42 44 end 43 object pnlWeb: TPanel 45 object pnlWeb: TPanel [3] 44 46 Left = 6 45 47 Top = 6 … … 66 68 end 67 69 end 68 object btnShow: TButton 70 object btnShow: TButton [4] 69 71 Left = 55 70 72 Top = 268 … … 76 78 OnClick = btnShowClick 77 79 end 80 inherited amgrMain: TVA508AccessibilityManager 81 Data = ( 82 ( 83 'Component = btnOK' 84 'Status = stsDefault') 85 ( 86 'Component = btnCancel' 87 'Status = stsDefault') 88 ( 89 'Component = btnBack' 90 'Status = stsDefault') 91 ( 92 'Component = pnlWeb' 93 'Status = stsDefault') 94 ( 95 'Component = webView' 96 'Status = stsDefault') 97 ( 98 'Component = btnShow' 99 'Status = stsDefault') 100 ( 101 'Component = frmOMHTML' 102 'Status = stsDefault')) 103 end 78 104 end -
cprs/trunk/CPRS-Chart/Orders/fOMHTML.pas
r456 r829 8 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 9 9 fOMAction, StdCtrls, OleCtrls, SHDocVw, MSHTML, activex, rOrders, uConst, 10 ExtCtrls ;10 ExtCtrls, VA508AccessibilityManager; 11 11 12 12 type … … 130 130 end; {for i} 131 131 CallBroker; 132 Dest.Assign(RPCBrokerV.Results);132 FastAssign(RPCBrokerV.Results, Dest); 133 133 end; 134 134 … … 159 159 CallBroker; 160 160 WPText.Free; 161 Dest.Assign(RPCBrokerV.Results);161 FastAssign(RPCBrokerV.Results, Dest); 162 162 end; 163 163 -
cprs/trunk/CPRS-Chart/Orders/fOMNavA.dfm
r456 r829 1 object frmOMNavA: TfrmOMNavA 2 Left = 265 3 Top = 445 4 Width = 491 5 Height = 305 1 inherited frmOMNavA: TfrmOMNavA 2 Left = 212 3 Top = 354 6 4 BorderIcons = [] 7 Caption = 'frmOMNavA' 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 = [] 5 Caption = 'Order Menu' 6 ClientHeight = 278 7 ClientWidth = 483 14 8 OldCreateOrder = True 15 9 OnActivate = FormActivate … … 18 12 OnDestroy = FormDestroy 19 13 OnResize = FormResize 14 ExplicitLeft = 212 15 ExplicitTop = 354 16 ExplicitWidth = 491 17 ExplicitHeight = 312 20 18 PixelsPerInch = 96 21 19 TextHeight = 13 22 object pnlTool: TPanel 20 object pnlTool: TPanel [0] 23 21 Left = 0 24 22 Top = 0 … … 30 28 Color = clHighlight 31 29 Font.Charset = DEFAULT_CHARSET 32 Font.Color = cl White30 Font.Color = clHighlightText 33 31 Font.Height = -11 34 32 Font.Name = 'MS Sans Serif' … … 44 42 Width = 50 45 43 Height = 17 44 Align = alRight 46 45 Caption = 'Done' 47 46 Font.Charset = DEFAULT_CHARSET 48 Font.Color = cl White47 Font.Color = clBtnText 49 48 Font.Height = -11 50 49 Font.Name = 'MS Sans Serif' … … 53 52 TabOrder = 0 54 53 OnClick = cmdDoneClick 55 Align = alRight56 54 end 57 55 object cmdPrev: TBitBtn … … 104 102 end 105 103 end 106 object grdMenu: TCaptionStringGrid 104 object grdMenu: TCaptionStringGrid [1] 107 105 Left = 0 108 106 Top = 19 … … 129 127 Caption = 'Menu or Dialog Name' 130 128 end 129 inherited amgrMain: TVA508AccessibilityManager 130 Left = 8 131 Top = 40 132 Data = ( 133 ( 134 'Component = pnlTool' 135 'Status = stsDefault') 136 ( 137 'Component = cmdDone' 138 'Status = stsDefault') 139 ( 140 'Component = cmdPrev' 141 'Status = stsDefault') 142 ( 143 'Component = cmdNext' 144 'Status = stsDefault') 145 ( 146 'Component = grdMenu' 147 'Status = stsDefault') 148 ( 149 'Component = frmOMNavA' 150 'Status = stsDefault')) 151 end 152 object accEventsGrdMenu: TVA508ComponentAccessibility 153 Component = grdMenu 154 OnCaptionQuery = accEventsGrdMenuCaptionQuery 155 OnValueQuery = accEventsGrdMenuValueQuery 156 Left = 40 157 Top = 40 158 end 131 159 end -
cprs/trunk/CPRS-Chart/Orders/fOMNavA.pas
r456 r829 7 7 uses 8 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 9 Buttons, Grids, StdCtrls, ORCtrls, ExtCtrls, uConst, rOrders, uOrders, fFrame; 9 Buttons, Grids, StdCtrls, ORCtrls, ExtCtrls, uConst, rOrders, uOrders, fFrame, fBase508Form, 10 VA508AccessibilityManager; 10 11 11 12 type 12 TfrmOMNavA = class(T Form)13 TfrmOMNavA = class(TfrmBase508Form) 13 14 pnlTool: TPanel; 14 15 cmdDone: TORAlignButton; … … 16 17 cmdPrev: TBitBtn; 17 18 cmdNext: TBitBtn; 19 accEventsGrdMenu: TVA508ComponentAccessibility; 18 20 procedure FormActivate(Sender: TObject); 19 21 procedure FormClose(Sender: TObject; var Action: TCloseAction); … … 42 44 Shift: TShiftState); 43 45 procedure FormResize(Sender: TObject); 46 procedure accEventsGrdMenuCaptionQuery(Sender: TObject; 47 var Text: string); 48 procedure accEventsGrdMenuValueQuery(Sender: TObject; 49 var Text: string); 44 50 private 45 51 FOrderingMenu: Integer; … … 88 94 89 95 uses rODBase, ORFn, fODBase,fODGen, fODAuto, fOMVerify, uCore, rMisc, uODBase, 90 fOrders, uAccessibleStringGrid;96 fOrders, VAUtils; 91 97 92 98 const … … 271 277 NoFresh := True; 272 278 ResizeFont; 273 TAccessibleStringGrid.WrapControl(grdMenu);279 // TAccessibleStringGrid.WrapControl(grdMenu); 274 280 end; 275 281 … … 288 294 end; 289 295 296 procedure TfrmOMNavA.accEventsGrdMenuCaptionQuery(Sender: TObject; 297 var Text: string); 298 begin 299 Text := pnlTool.Caption; 300 end; 301 290 302 procedure TfrmOMNavA.FormDestroy(Sender: TObject); 291 303 var … … 294 306 OrderMenuItem: TOrderMenuItem; 295 307 begin 296 TAccessibleStringGrid.UnwrapControl(grdMenu);308 // TAccessibleStringGrid.UnwrapControl(grdMenu); 297 309 ClearMenuGrid; 298 310 for i := 0 to FMenuHits.Count - 1 do … … 371 383 if Selected then 372 384 begin 373 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then 374 Font.Color := clBlue; 385 Font.Color := Get508CompliantColor(clBlue); 375 386 Font.Style := Font.Style + [fsUnderline]; 376 387 end; … … 470 481 //frmFrame.UpdatePtInfoOnRefresh; 471 482 FOrderMenuItem := TOrderMenuItem(Objects[Col, Row]); 472 if FOrderMenuItem.Display > 0 then FOrderMenuItem := nil; // display only 483 if Assigned(FOrderMenuItem) then 484 if FOrderMenuItem.Display > 0 then FOrderMenuItem := nil; // display only 473 485 if FOrderMenuItem <> nil then 474 486 begin … … 624 636 Result := False; 625 637 InfoBox(x, TC_DISABLED, MB_OK); 638 end; 639 end; 640 641 procedure TfrmOMNavA.accEventsGrdMenuValueQuery(Sender: TObject; 642 var Text: string); 643 var 644 OrderMenuItem : TOrderMenuItem; 645 begin 646 inherited; 647 if grdMenu.Objects[grdMenu.Col, grdMenu.Row] is TOrderMenuItem then begin 648 OrderMenuItem := TOrderMenuItem(grdMenu.Objects[grdMenu.Col, grdMenu.Row]); 649 if OrderMenuItem.AutoAck then 650 Text := 'Auto Accept, '+ OrderMenuItem.ItemText; 626 651 end; 627 652 end; … … 660 685 end; {'M'} 661 686 'Q': ActivateOrderDialog(IntToStr(AnItem.IEN), FDelayEvent, Self, 0); 662 'P': ShowM essage('Order Dialogs of type "Prompt" cannot be processed.');687 'P': ShowMsg('Order Dialogs of type "Prompt" cannot be processed.'); 663 688 'O': begin 664 689 // disable initially, since the 1st item in the set may be a menu … … 667 692 then Self.Enabled := True; 668 693 end; 669 else ShowM essage('Unknown Order Dialog type: ' + AnItem.DlgType);694 else ShowMsg('Unknown Order Dialog type: ' + AnItem.DlgType); 670 695 end; {case} 671 696 end; -
cprs/trunk/CPRS-Chart/Orders/fOMProgress.dfm
r456 r829 2 2 Left = 221 3 3 Top = 542 4 Width = 1675 Height = 2156 4 BorderIcons = [] 7 5 Caption = 'Order Set Progress' 8 OnCreate = FormCreate 6 ClientHeight = 188 7 ClientWidth = 159 8 ExplicitWidth = 167 9 ExplicitHeight = 215 9 10 PixelsPerInch = 96 10 11 TextHeight = 13 11 object lstItems: TCheckListBox 12 object lstItems: TCheckListBox [0] 12 13 Left = 0 13 14 Top = 0 … … 15 16 Height = 167 16 17 Align = alClient 17 Color = 1579315118 Color = clCream 18 19 ItemHeight = 13 19 20 TabOrder = 0 20 21 end 21 object cmdStop: TORAlignButton 22 object cmdStop: TORAlignButton [1] 22 23 Left = 0 23 24 Top = 167 24 25 Width = 159 25 26 Height = 21 27 Align = alBottom 26 28 Caption = 'Stop Order Set' 27 29 TabOrder = 1 28 Align = alBottom 30 end 31 inherited amgrMain: TVA508AccessibilityManager 32 Data = ( 33 ( 34 'Component = lstItems' 35 'Status = stsDefault') 36 ( 37 'Component = cmdStop' 38 'Status = stsDefault') 39 ( 40 'Component = frmOMProgress' 41 'Status = stsDefault')) 29 42 end 30 43 end -
cprs/trunk/CPRS-Chart/Orders/fOMProgress.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORCtrls, CheckLst, ORFn ;7 fAutoSz, StdCtrls, ORCtrls, CheckLst, ORFn, VA508AccessibilityManager; 8 8 9 9 type … … 11 11 lstItems: TCheckListBox; 12 12 cmdStop: TORAlignButton; 13 procedure FormCreate(Sender: TObject);14 13 private 15 14 { Private declarations } … … 46 45 end; 47 46 48 procedure TfrmOMProgress.FormCreate(Sender: TObject);49 begin50 inherited;51 lstItems.Color := ReadOnlyColor;52 end;53 54 47 end. -
cprs/trunk/CPRS-Chart/Orders/fOMSet.dfm
r456 r829 1 objectfrmOMSet: TfrmOMSet1 inherited frmOMSet: TfrmOMSet 2 2 Left = 209 3 3 Top = 191 4 Width = 1135 Height = 2296 4 BorderIcons = [] 7 5 Caption = 'Selected Orders' 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 = 202 7 ClientWidth = 105 14 8 FormStyle = fsStayOnTop 15 OldCreateOrder = False16 9 OnClose = FormClose 17 10 OnCloseQuery = FormCloseQuery 18 11 OnCreate = FormCreate 19 12 OnDestroy = FormDestroy 13 ExplicitWidth = 113 14 ExplicitHeight = 229 20 15 DesignSize = ( 21 16 105 … … 23 18 PixelsPerInch = 96 24 19 TextHeight = 13 25 object lstSet: TCheckListBox 20 object lstSet: TCheckListBox [0] 26 21 Left = 0 27 22 Top = 0 … … 34 29 TabOrder = 0 35 30 end 36 object cmdInterupt: TButton 31 object cmdInterupt: TButton [1] 37 32 Left = 4 38 33 Top = 172 … … 44 39 OnClick = cmdInteruptClick 45 40 end 41 inherited amgrMain: TVA508AccessibilityManager 42 Data = ( 43 ( 44 'Component = lstSet' 45 'Status = stsDefault') 46 ( 47 'Component = cmdInterupt' 48 'Status = stsDefault') 49 ( 50 'Component = frmOMSet' 51 'Status = stsDefault')) 52 end 46 53 end -
cprs/trunk/CPRS-Chart/Orders/fOMSet.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, CheckLst, rOrders, uConst, ORFn, rODMeds, fODBase,uCore,fOrders, fframe; 7 StdCtrls, CheckLst, rOrders, uConst, ORFn, rODMeds, fODBase,uCore,fOrders, fframe, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type … … 17 18 end; 18 19 19 TfrmOMSet = class(T Form)20 TfrmOMSet = class(TfrmBase508Form) 20 21 lstSet: TCheckListBox; 21 22 cmdInterupt: TButton; … … 149 150 'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then 150 151 begin 151 if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then 152 lstSet.Checked[lstSet.ItemIndex] := True 153 else SkipToNext; 152 if Not FClosing then 153 begin 154 if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then 155 lstSet.Checked[lstSet.ItemIndex] := True 156 else SkipToNext; 157 end; 154 158 end; 155 159 'M': if ActivateOrderMenu( IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) -
cprs/trunk/CPRS-Chart/Orders/fOMVerify.dfm
r456 r829 2 2 Left = 328 3 3 Top = 243 4 Width = 5875 Height = 2086 4 BorderIcons = [] 7 5 Caption = 'New Order' 6 ClientHeight = 181 7 ClientWidth = 579 8 8 OnClose = FormClose 9 9 OnCreate = FormCreate 10 ExplicitWidth = 587 11 ExplicitHeight = 208 10 12 PixelsPerInch = 96 11 13 TextHeight = 13 12 object cmdAccept: TButton 14 object cmdAccept: TButton [0] 13 15 Left = 165 14 16 Top = 154 … … 20 22 OnClick = cmdAcceptClick 21 23 end 22 object cmdEdit: TButton 24 object cmdEdit: TButton [1] 23 25 Left = 253 24 26 Top = 154 … … 29 31 OnClick = cmdEditClick 30 32 end 31 object cmdCancel: TButton 33 object cmdCancel: TButton [2] 32 34 Left = 341 33 35 Top = 154 … … 39 41 OnClick = cmdCancelClick 40 42 end 41 object memText: TRichEdit 43 object memText: TRichEdit [3] 42 44 Left = 6 43 45 Top = 6 … … 69 71 OnKeyUp = memTextKeyUp 70 72 end 73 inherited amgrMain: TVA508AccessibilityManager 74 Data = ( 75 ( 76 'Component = cmdAccept' 77 'Status = stsDefault') 78 ( 79 'Component = cmdEdit' 80 'Status = stsDefault') 81 ( 82 'Component = cmdCancel' 83 'Status = stsDefault') 84 ( 85 'Component = memText' 86 'Status = stsDefault') 87 ( 88 'Component = frmOMVerify' 89 'Status = stsDefault')) 90 end 71 91 end -
cprs/trunk/CPRS-Chart/Orders/fOMVerify.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ComCtrls ;7 fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOrderComment.dfm
r456 r829 2 2 Left = 334 3 3 Top = 234 4 Height = 2895 4 Caption = 'Comments for Order' 5 ClientHeight = 262 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitWidth = 320 9 ExplicitHeight = 289 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 10 object Label1: TLabel 12 object Label1: TLabel [0] 11 13 Left = 8 12 14 Top = 80 … … 15 17 Caption = 'Comments:' 16 18 end 17 object cmdOK: TButton 19 object cmdOK: TButton [1] 18 20 Left = 267 19 21 Top = 233 … … 25 27 OnClick = cmdOKClick 26 28 end 27 object cmdCancel: TButton 29 object cmdCancel: TButton [2] 28 30 Left = 347 29 31 Top = 233 … … 35 37 OnClick = cmdCancelClick 36 38 end 37 object memOrder: TMemo 39 object memOrder: TMemo [3] 38 40 Left = 8 39 41 Top = 8 … … 48 50 WantReturns = False 49 51 end 50 object memComments: TRichEdit 52 object memComments: TRichEdit [4] 51 53 Left = 8 52 54 Top = 94 … … 58 60 OnKeyUp = memCommentsKeyUp 59 61 end 62 inherited amgrMain: TVA508AccessibilityManager 63 Data = ( 64 ( 65 'Component = cmdOK' 66 'Status = stsDefault') 67 ( 68 'Component = cmdCancel' 69 'Status = stsDefault') 70 ( 71 'Component = memOrder' 72 'Status = stsDefault') 73 ( 74 'Component = memComments' 75 'Status = stsDefault') 76 ( 77 'Component = frmWardComments' 78 'Status = stsDefault')) 79 end 60 80 end -
cprs/trunk/CPRS-Chart/Orders/fOrderComment.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders ;7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOrderFlag.dfm
r456 r829 2 2 Left = 334 3 3 Top = 234 4 Height = 1915 4 Caption = 'Flag Order' 5 ClientHeight = 264 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitLeft = 334 9 ExplicitTop = 234 10 ExplicitWidth = 320 11 ExplicitHeight = 291 8 12 PixelsPerInch = 96 9 13 TextHeight = 13 10 object Label1: TLabel 14 object Label1: TLabel [0] 11 15 Left = 8 12 16 Top = 80 13 Width = 7517 Width = 199 14 18 Height = 13 15 Caption = 'Reason for Flag '19 Caption = 'Reason for Flag (Enter or select from list)' 16 20 end 17 object lblAlertRecipient: TLabel 21 object lblAlertRecipient: TLabel [1] 18 22 Left = 8 19 Top = 12323 Top = 211 20 24 Width = 69 21 25 Height = 13 22 26 Caption = 'Alert Recipient' 23 27 end 24 object txtReason: TCaptionEdit 25 Left = 8 26 Top = 94 27 Width = 411 28 Height = 21 29 MaxLength = 80 30 TabOrder = 0 31 Caption = 'Reason for Flag' 32 end 33 object cmdOK: TButton 28 object cmdOK: TButton [2] 34 29 Left = 267 35 Top = 13930 Top = 227 36 31 Width = 72 37 32 Height = 21 … … 41 36 OnClick = cmdOKClick 42 37 end 43 object cmdCancel: TButton 38 object cmdCancel: TButton [3] 44 39 Left = 347 45 Top = 13940 Top = 227 46 41 Width = 72 47 42 Height = 21 … … 51 46 OnClick = cmdCancelClick 52 47 end 53 object memOrder: TMemo 48 object memOrder: TMemo [4] 54 49 Left = 8 55 50 Top = 8 … … 63 58 WantReturns = False 64 59 end 65 object cboAlertRecipient: TORComboBox 60 object cboAlertRecipient: TORComboBox [5] 66 61 Left = 7 67 Top = 13962 Top = 227 68 63 Width = 226 69 64 Height = 21 … … 89 84 CharsNeedMatch = 1 90 85 end 86 object cboFlagReason: TORComboBox [6] 87 Left = 8 88 Top = 99 89 Width = 411 90 Height = 106 91 Style = orcsSimple 92 AutoSelect = True 93 Color = clWindow 94 DropDownCount = 8 95 ItemHeight = 13 96 ItemTipColor = clWindow 97 ItemTipEnable = True 98 ListItemsOnly = False 99 LongList = False 100 LookupPiece = 0 101 MaxLength = 80 102 Pieces = '2' 103 Sorted = False 104 SynonymChars = '<>' 105 TabOrder = 0 106 CharsNeedMatch = 1 107 end 108 inherited amgrMain: TVA508AccessibilityManager 109 Data = ( 110 ( 111 'Component = cmdOK' 112 'Status = stsDefault') 113 ( 114 'Component = cmdCancel' 115 'Status = stsDefault') 116 ( 117 'Component = memOrder' 118 'Status = stsDefault') 119 ( 120 'Component = cboAlertRecipient' 121 'Status = stsDefault') 122 ( 123 'Component = cboFlagReason' 124 'Status = stsDefault') 125 ( 126 'Component = frmFlagOrder' 127 'Status = stsDefault')) 128 end 91 129 end -
cprs/trunk/CPRS-Chart/Orders/fOrderFlag.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls ;7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type 10 10 TfrmFlagOrder = class(TfrmAutoSz) 11 txtReason: TCaptionEdit;12 11 Label1: TLabel; 13 12 cmdOK: TButton; … … 16 15 lblAlertRecipient: TLabel; 17 16 cboAlertRecipient: TORComboBox; 17 cboFlagReason: TORComboBox; 18 18 procedure FormCreate(Sender: TObject); 19 19 procedure cmdOKClick(Sender: TObject); … … 51 51 if OKPressed then 52 52 begin 53 FlagOrder(AnOrder, txtReason.Text, AlertRecip);53 FlagOrder(AnOrder, cboFlagReason.Text, AlertRecip); 54 54 Result := True; 55 55 end; … … 62 62 63 63 procedure TfrmFlagOrder.FormCreate(Sender: TObject); 64 var 65 tmpList: TStringList; 64 66 begin 65 67 inherited; 66 68 OKPressed := False; 69 tmpList := TStringList.Create; 70 try 71 GetUserListParam(tmpList, 'OR FLAGGED ORD REASONS'); 72 FastAssign(tmpList, cboFlagReason.Items); 73 finally 74 tmpList.Free; 75 end; 67 76 cboAlertRecipient.InitLongList(''); 68 77 //cboAlertRecipient.SelectByIEN(User.DUZ); … … 75 84 begin 76 85 inherited; 77 if txtReason.Text = '' then 86 if cboFlagReason.Text = '' then 87 //if txtReason.Text = '' then 78 88 begin 79 89 InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK); -
cprs/trunk/CPRS-Chart/Orders/fOrderSaveQuick.dfm
r456 r829 2 2 Left = 308 3 3 Top = 171 4 Width = 3635 Height = 3626 4 Caption = 'Add to Common List (Meds, Inpatient)' 5 ClientHeight = 335 6 ClientWidth = 355 7 7 Position = poScreenCenter 8 8 OnCreate = FormCreate 9 ExplicitLeft = 308 10 ExplicitTop = 171 11 ExplicitWidth = 363 12 ExplicitHeight = 362 9 13 PixelsPerInch = 96 10 14 TextHeight = 13 11 object Panel1: TPanel 15 object Panel1: TPanel [0] 12 16 Left = 0 13 17 Top = 0 … … 49 53 end 50 54 end 51 object Panel2: TPanel 55 object Panel2: TPanel [1] 52 56 Left = 0 53 57 Top = 113 … … 162 166 end 163 167 end 164 object Panel3: TPanel 168 object Panel3: TPanel [2] 165 169 Left = 0 166 170 Top = 294 … … 189 193 end 190 194 end 195 inherited amgrMain: TVA508AccessibilityManager 196 Data = ( 197 ( 198 'Component = Panel1' 199 'Status = stsDefault') 200 ( 201 'Component = memOrder' 202 'Status = stsDefault') 203 ( 204 'Component = txtDisplayName' 205 'Status = stsDefault') 206 ( 207 'Component = Panel2' 208 'Status = stsDefault') 209 ( 210 'Component = lstQuickList' 211 'Status = stsDefault') 212 ( 213 'Component = pnlUpButton' 214 'Status = stsDefault') 215 ( 216 'Component = pnlDownButton' 217 'Status = stsDefault') 218 ( 219 'Component = cmdRename' 220 'Status = stsDefault') 221 ( 222 'Component = cmdDelete' 223 'Status = stsDefault') 224 ( 225 'Component = Panel3' 226 'Status = stsDefault') 227 ( 228 'Component = cmdOK' 229 'Status = stsDefault') 230 ( 231 'Component = cmdCancel' 232 'Status = stsDefault') 233 ( 234 'Component = frmSaveQuickOrder' 235 'Status = stsDefault')) 236 end 191 237 end -
cprs/trunk/CPRS-Chart/Orders/fOrderSaveQuick.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders; 7 fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders, 8 VA508AccessibilityManager; 8 9 9 10 type … … 58 59 TX_NO_TEXT = 'No fields have been entered - cannot save as quick order.'; 59 60 TC_NO_TEXT = 'Save as Quick Order'; 61 TX_DUP_NAME = 'There is already a quick order with that name.' + CRLF + 62 'Please either delete the original or enter a different name.'; 63 TC_DUP_NAME = 'Unable to save quick order'; 64 TC_DUP_RENAME = 'Unable to rename quick order'; 60 65 61 66 function EditCommonList(ADisplayGroup: Integer): Boolean; … … 84 89 ItemIndex := 0; 85 90 end; 91 ActiveControl := lstQuickList; 86 92 ShowModal; 87 93 if OKPressed then … … 128 134 else 129 135 DGroupName := NameOfDGroup(ResponseSet.DisplayGroup); 136 if DGroupName = 'Inpt. Meds' then 137 begin 138 ResponseSet.DisplayGroup := InptDisp; 139 DGroupName := NameOfDGroup(InptDisp); 140 end; 130 141 Caption := 'Add Quick Order (' + DGroupName + ')'; 131 142 lblQuickList.Caption := 'Common List for ' + DGroupName; … … 145 156 ItemIndex := 0; 146 157 end; 158 ActiveControl := txtDisplayName; 147 159 ShowModal; 148 160 if OKPressed then … … 213 225 var 214 226 AName: string; 227 i: integer; 215 228 begin 216 229 inherited; … … 219 232 if ItemIndex < 0 then Exit; 220 233 AName := Piece(Items[ItemIndex], U, 2); 221 if ExecuteRename(AName, TX_QO_RENAME) 222 then Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName; 223 end; 234 if ExecuteRename(AName, TX_QO_RENAME) then 235 begin 236 i := Items.IndexOf(AName); 237 if (i > -1) and (i <> ItemIndex) then 238 InfoBox(TX_DUP_NAME, TC_DUP_RENAME, MB_ICONERROR or MB_OK) 239 else 240 Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName; 241 end; 242 end; 243 224 244 end; 225 245 … … 247 267 248 268 procedure TfrmSaveQuickOrder.cmdOKClick(Sender: TObject); 249 begin 250 inherited; 251 if txtDisplayName.Enabled and (txtDisplayName.Text = '') then 252 begin 253 InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK); 254 Exit; 269 var 270 i: integer; 271 begin 272 inherited; 273 if txtDisplayName.Enabled then 274 begin 275 if (txtDisplayName.Text = '') then 276 begin 277 InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK); 278 Exit; 279 end; 280 for i := 0 to lstQuickList.Count - 1 do 281 if (UpperCase(lstQuickList.DisplayText[i]) = UpperCase(txtDisplayName.Text)) and (i > 0) then 282 begin 283 InfoBox(TX_DUP_NAME, TC_DUP_NAME, MB_ICONERROR or MB_OK); 284 lstQuickList.ItemIndex := i; 285 Exit; 286 end; 255 287 end; 256 288 OKPressed := True; -
cprs/trunk/CPRS-Chart/Orders/fOrderUnflag.dfm
r456 r829 2 2 Left = 365 3 3 Top = 389 4 Height = 2305 4 Caption = 'Unflag Order' 5 ClientHeight = 203 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitWidth = 320 9 ExplicitHeight = 230 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 10 object Label1: TLabel 12 object Label1: TLabel [0] 11 13 Left = 8 12 14 Top = 123 … … 15 17 Caption = 'Comment (optional)' 16 18 end 17 object txtComment: TCaptionEdit 19 object txtComment: TCaptionEdit [1] 18 20 Left = 8 19 21 Top = 137 … … 24 26 Caption = 'Comment (optional)' 25 27 end 26 object cmdOK: TButton 28 object cmdOK: TButton [2] 27 29 Left = 267 28 30 Top = 174 … … 34 36 OnClick = cmdOKClick 35 37 end 36 object cmdCancel: TButton 38 object cmdCancel: TButton [3] 37 39 Left = 347 38 40 Top = 174 … … 44 46 OnClick = cmdCancelClick 45 47 end 46 object memReason: TMemo 48 object memReason: TMemo [4] 47 49 Left = 8 48 50 Top = 80 … … 54 56 WantReturns = False 55 57 end 56 object memOrder: TMemo 58 object memOrder: TMemo [5] 57 59 Left = 8 58 60 Top = 8 … … 64 66 WantReturns = False 65 67 end 68 inherited amgrMain: TVA508AccessibilityManager 69 Data = ( 70 ( 71 'Component = txtComment' 72 'Status = stsDefault') 73 ( 74 'Component = cmdOK' 75 'Status = stsDefault') 76 ( 77 'Component = cmdCancel' 78 'Status = stsDefault') 79 ( 80 'Component = memReason' 81 'Status = stsDefault') 82 ( 83 'Component = memOrder' 84 'Status = stsDefault') 85 ( 86 'Component = frmUnflagOrder' 87 'Status = stsDefault')) 88 end 66 89 end -
cprs/trunk/CPRS-Chart/Orders/fOrderUnflag.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls ;7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOrderVw.dfm
r456 r829 2 2 Left = 340 3 3 Top = 165 4 Width = 4295 Height = 4406 4 Caption = 'Custom Order View' 5 ClientHeight = 413 6 ClientWidth = 421 7 7 Position = poScreenCenter 8 8 OnCreate = FormCreate 9 ExplicitLeft = 340 10 ExplicitTop = 165 11 ExplicitWidth = 429 12 ExplicitHeight = 440 9 13 PixelsPerInch = 96 10 14 TextHeight = 13 11 object pnlView: TPanel 15 object pnlView: TPanel [0] 12 16 Left = 0 13 17 Top = 0 … … 32 36 Caption = 'All Services, Active Orders' 33 37 Layout = tlCenter 34 end 35 end 36 object Panel1: TPanel 38 ExplicitWidth = 153 39 ExplicitHeight = 13 40 end 41 end 42 object Panel1: TPanel [1] 37 43 Left = 0 38 44 Top = 21 39 45 Width = 421 40 Height = 27 746 Height = 278 41 47 Align = alClient 42 48 BevelOuter = bvNone … … 45 51 Left = 211 46 52 Top = 0 47 Width = 3 48 Height = 277 49 Cursor = crHSplit 53 Height = 278 50 54 MinSize = 1 51 55 OnMoved = Splitter1Moved … … 55 59 Top = 0 56 60 Width = 211 57 Height = 27 761 Height = 278 58 62 Align = alLeft 59 63 Constraints.MinWidth = 15 … … 68 72 Caption = 'Order Status' 69 73 Layout = tlCenter 74 ExplicitWidth = 59 70 75 end 71 76 object trFilters: TCaptionTreeView … … 73 78 Top = 14 74 79 Width = 209 75 Height = 26 280 Height = 263 76 81 Align = alClient 82 HideSelection = False 77 83 Indent = 19 78 84 TabOrder = 0 … … 85 91 Top = 0 86 92 Width = 207 87 Height = 27 793 Height = 278 88 94 Align = alClient 89 95 Constraints.MinWidth = 15 … … 98 104 Caption = 'Service/Section' 99 105 Layout = tlCenter 106 ExplicitWidth = 77 100 107 end 101 108 object treService: TCaptionTreeView … … 103 110 Top = 14 104 111 Width = 205 105 Height = 26 2112 Height = 263 106 113 Align = alClient 114 HideSelection = False 107 115 Indent = 19 108 116 TabOrder = 0 … … 112 120 end 113 121 end 114 object Panel4: TPanel 122 object Panel4: TPanel [2] 115 123 Left = 0 116 Top = 29 8124 Top = 299 117 125 Width = 421 118 126 Height = 114 … … 224 232 end 225 233 end 234 inherited amgrMain: TVA508AccessibilityManager 235 Data = ( 236 ( 237 'Component = pnlView' 238 'Status = stsDefault') 239 ( 240 'Component = Panel1' 241 'Status = stsDefault') 242 ( 243 'Component = Panel2' 244 'Status = stsDefault') 245 ( 246 'Component = trFilters' 247 'Status = stsDefault') 248 ( 249 'Component = Panel3' 250 'Status = stsDefault') 251 ( 252 'Component = treService' 253 'Status = stsDefault') 254 ( 255 'Component = Panel4' 256 'Status = stsDefault') 257 ( 258 'Component = chkDateRange' 259 'Status = stsDefault') 260 ( 261 'Component = GroupBox1' 262 'Status = stsDefault') 263 ( 264 'Component = calFrom' 265 'Status = stsDefault') 266 ( 267 'Component = calThru' 268 'Status = stsDefault') 269 ( 270 'Component = chkInvChrono' 271 'Status = stsDefault') 272 ( 273 'Component = chkByService' 274 'Status = stsDefault') 275 ( 276 'Component = cmdOK' 277 'Status = stsDefault') 278 ( 279 'Component = cmdCancel' 280 'Status = stsDefault') 281 ( 282 'Component = frmOrderView' 283 'Status = stsDefault')) 284 end 226 285 end -
cprs/trunk/CPRS-Chart/Orders/fOrderVw.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, ORFn, rOrders, ORDtTm; 7 fAutoSz, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, ORFn, rOrders, ORDtTm, 8 VA508AccessibilityManager; 8 9 9 10 type … … 162 163 Item[i].Expanded := True; 163 164 Item[i].Selected := True; 164 FDGroupName := Item[i].Text; 165 FFilter := Integer(Item[i].Data); 166 FFilterName := Item[i].Text; 165 167 Break; 166 168 end; … … 303 305 FFilter := Integer(Node.Data); 304 306 FFilterName := Node.Text; 307 chkDateRange.Enabled := True; 305 308 if FFilter = 2 then // disallow date range for active orders view 306 309 begin … … 308 311 chkDateRangeClick(Self); 309 312 end; 313 if FFilter = 5 then // disallow date range for expiring orders view 314 begin 315 chkDateRange.Checked := False; 316 chkDateRangeClick(Self); 317 chkDateRange.Enabled := False; 318 end; 310 319 if FFilter in [8, 9, 10, 20] then chkDateRange.Checked := True else 311 320 begin -
cprs/trunk/CPRS-Chart/Orders/fOrders.dfm
r456 r829 1 1 inherited frmOrders: TfrmOrders 2 2 Left = 451 3 Top = 250 4 Width = 774 5 Height = 579 3 Top = 177 6 4 HelpContext = 4000 7 5 Caption = 'Orders Page' 6 ClientHeight = 571 7 ClientWidth = 766 8 8 HelpFile = 'overvw' 9 9 Menu = mnuOrders 10 10 OnDestroy = FormDestroy 11 11 OnShow = FormShow 12 ExplicitWidth = 774 13 ExplicitHeight = 617 12 14 PixelsPerInch = 96 13 15 TextHeight = 13 14 16 inherited shpPageBottom: TShape 15 Top = 5 2817 Top = 566 16 18 Width = 766 19 ExplicitTop = 528 20 ExplicitWidth = 766 17 21 end 18 22 inherited sptHorz: TSplitter 19 23 Left = 117 20 Height = 5 2824 Height = 566 21 25 OnMoved = sptHorzMoved 26 ExplicitLeft = 117 27 ExplicitHeight = 528 22 28 end 23 29 inherited pnlLeft: TPanel 24 30 Width = 117 25 Height = 528 31 Height = 566 32 ExplicitWidth = 117 33 ExplicitHeight = 566 26 34 object OROffsetLabel1: TOROffsetLabel 27 35 Left = 0 … … 77 85 Top = 116 78 86 Width = 117 79 Height = 4 1287 Height = 450 80 88 Align = alClient 81 89 ItemHeight = 13 … … 94 102 Width = 117 95 103 Height = 18 104 Align = alTop 96 105 Caption = 'Write Delayed Orders' 97 106 TabOrder = 1 98 107 OnClick = btnDelayedOrderClick 99 Align = alTop100 108 Alignment = taLeftJustify 101 109 end … … 104 112 Left = 121 105 113 Width = 645 106 Height = 5 28114 Height = 566 107 115 ParentColor = True 108 116 ParentCtl3D = False 109 117 ParentFont = False 110 118 OnResize = pnlRightResize 119 ExplicitLeft = 121 120 ExplicitWidth = 645 121 ExplicitHeight = 566 111 122 object lblOrders: TOROffsetLabel 112 123 Left = 0 … … 147 158 Width = 645 148 159 Height = 17 149 DragReorder = False150 160 Sections = < 151 161 item … … 216 226 Top = 36 217 227 Width = 645 218 Height = 492228 Height = 530 219 229 Style = lbOwnerDrawVariable 220 230 Align = alClient … … 229 239 OnDrawItem = lstOrdersDrawItem 230 240 OnMeasureItem = lstOrdersMeasureItem 231 RightClickSelect = True232 241 Caption = 'Active Orders' 233 242 end 243 end 244 inherited amgrMain: TVA508AccessibilityManager 245 Data = ( 246 ( 247 'Component = lstSheets' 248 'Status = stsDefault') 249 ( 250 'Component = lstWrite' 251 'Status = stsDefault') 252 ( 253 'Component = btnDelayedOrder' 254 'Status = stsDefault') 255 ( 256 'Component = hdrOrders' 257 'Status = stsDefault') 258 ( 259 'Component = lstOrders' 260 'Status = stsDefault') 261 ( 262 'Component = pnlLeft' 263 'Status = stsDefault') 264 ( 265 'Component = pnlRight' 266 'Status = stsDefault') 267 ( 268 'Component = frmOrders' 269 'Status = stsDefault')) 234 270 end 235 271 object mnuOrders: TMainMenu -
cprs/trunk/CPRS-Chart/Orders/fOrders.pas
r456 r829 8 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fHSplit, StdCtrls, 9 9 ExtCtrls, Menus, ORCtrls, ComCtrls, ORFn, rOrders, fODBase, uConst, uCore, uOrders,UBACore, 10 UBAGlobals ;10 UBAGlobals, VA508AccessibilityManager, fBase508Form; 11 11 12 12 type … … 165 165 private 166 166 { Private declarations } 167 OrderListClickProcessing : Boolean; 167 168 FDfltSort: Integer; 168 169 FCurrentView: TOrderView; … … 184 185 FDontCheck: boolean; 185 186 FParentComplexOrderID: string; 187 FHighContrast2Mode: boolean; 186 188 function CanChangeOrderView: Boolean; 187 189 function GetEvtIFN(AnIndex: integer): string; … … 205 207 procedure UseDefaultSort; 206 208 procedure SynchListToOrders; 207 //procedure ActivateDeactiveRenew;209 procedure ActivateDeactiveRenew; 208 210 procedure ValidateSelected(const AnAction, WarningMsg, WarningTitle: string); 209 211 procedure ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string; … … 214 216 function MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer; 215 217 function GetPlainText(AnOrder: TOrder; index: integer):string; 216 function PatientStatusChanged: boolean;218 //function PatientStatusChanged: boolean; 217 219 procedure UMEventOccur(var Message: TMessage); message UM_EVENTOCCUR; 218 220 function CheckOrderStatus: boolean; 221 procedure RightClickMessageHandler(var Msg: TMessage; var Handled: Boolean); 219 222 public 220 223 procedure setSectionWidths; //CQ6170 … … 267 270 fOMNavA, rCore, fOCSession, fOrdersPrint, fOrdersTS, fEffectDate, fODActive, fODChild, 268 271 fOrdersCopy, fOMVerify, fODAuto, rODBase, uODBase, rMeds,fODValidateAction, fMeds, uInit, fBALocalDiagnoses, 269 fODConsult, fClinicWardMeds, fActivateDeactivate; 272 fODConsult, fClinicWardMeds, fActivateDeactivate, VA2006Utils, rodMeds, 273 VA508AccessibilityRouter, VAUtils; 270 274 271 275 {$R *.DFM} … … 467 471 AChildList: TStringlist; 468 472 CplxOrderID: string; 473 DCNewOrder: boolean; 474 DCChangeItem: TChangeItem; 469 475 470 476 procedure RemoveFromOrderList(ChildOrderID: string); … … 512 518 then CanSign := CH_SIGN_YES 513 519 else CanSign := CH_SIGN_NA; 514 DCOrder(OrderForList, GetReqReason, ReturnedType); 520 DCNEwOrder := false; 521 if Changes.Orders.Count > 0 then 522 begin 523 for j := 0 to Changes.Orders.Count - 1 do 524 begin 525 DCChangeItem := TChangeItem(Changes.Orders.Items[j]); 526 if DCChangeItem.ID = OrderForList.ID then 527 begin 528 if (Pos('DC', OrderForList.ActionOn) = 0) then 529 DCNewOrder := True; 530 //else DCNewOrder := False; 531 end; 532 end; 533 end; 534 DCOrder(OrderForList, GetReqReason, DCNewOrder, ReturnedType); 515 535 Changes.Add(CH_ORD, OrderForList.ID, OrderForList.Text, '', CanSign); 516 536 FCompress := True; … … 587 607 begin 588 608 inherited; 609 OrderListClickProcessing := false; 610 FixHeaderControlDelphi2006Bug(hdrOrders); 589 611 PageID := CT_ORDERS; 590 lstOrders.Color := ReadOnlyColor;591 612 uOrderList := TList.Create; 592 613 uEvtDCList := TList.Create; … … 608 629 FDontCheck := False; 609 630 FParentComplexOrderID := ''; 631 // 508 black color scheme that causes problems 632 FHighContrast2Mode := BlackColorScheme and (ColorToRGB(clInfoBk) <> ColorToRGB(clBlack)); 633 AddMessageHandler(lstOrders, RightClickMessageHandler); 610 634 end; 611 635 … … 613 637 begin 614 638 inherited; 639 RemoveMessageHandler(lstOrders, RightClickMessageHandler); 615 640 ClearOrders(uOrderList); 616 641 uEvtDCList.Clear; … … 684 709 SaveTop := TopIndex; 685 710 Clear; 711 repaint; 686 712 for i := 0 to uOrderList.Count - 1 do 687 713 begin … … 881 907 inherited; 882 908 if not CanChangeOrderView then Exit; 883 AnOrderView := TOrderView.Create; 884 AnOrderView.Filter := STS_ACTIVE; 885 AnOrderView.DGroup := DGroupAll; 886 AnOrderView.ViewName := 'All Services, Active'; 887 AnOrderView.InvChrono := True; 888 AnOrderView.ByService := True; 889 AnOrderView.CtxtTime := 0; 890 AnOrderView.TextView := 0; 891 AnOrderView.EventDelay.EventType := 'C'; 892 AnOrderView.EventDelay.Specialty := 0; 893 AnOrderView.EventDelay.Effective := 0; 894 AnOrderView.EventDelay.EventIFN := 0; 895 AnOrderView.EventDelay.EventName := 'All Services, Active'; 896 SelectOrderView(AnOrderView); 897 with AnOrderView do if Changed then 898 begin 899 FCurrentView := AnOrderView; 900 if FCurrentView.Filter in [15,16,17,24] then 901 begin 902 FCompress := False; 903 mnuActRel.Visible := True; 904 popOrderRel.Visible := True; 905 end else 906 begin 907 mnuActRel.Visible := False; 908 popOrderRel.Visible := False; 909 end; 910 911 lstSheets.ItemIndex := -1; 912 lblWrite.Caption := 'Write Orders'; 913 lstWrite.Clear; 914 lstWrite.Caption := lblWrite.Caption; 915 LoadWriteOrders(lstWrite.Items); 916 RefreshOrderList(FROM_SERVER); 917 918 if ByService then 919 begin 920 if InvChrono then FDfltSort := OVS_CATINV else FDfltSort := OVS_CATFWD; 921 end else 922 begin 923 if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD; 924 end; 909 AnOrderView := TOrderView.Create; // - this starts fresh instead, since CPRS v22 910 try 911 AnOrderView.Assign(FCurrentView); // RV - v27.1 - preload form with current view params 912 (* AnOrderView.Filter := STS_ACTIVE; - CQ #11261 913 AnOrderView.DGroup := DGroupAll; 914 AnOrderView.ViewName := 'All Services, Active'; 915 AnOrderView.InvChrono := True; 916 AnOrderView.ByService := True; 917 AnOrderView.CtxtTime := 0; 918 AnOrderView.TextView := 0; 919 AnOrderView.EventDelay.EventType := 'C'; 920 AnOrderView.EventDelay.Specialty := 0; 921 AnOrderView.EventDelay.Effective := 0; 922 AnOrderView.EventDelay.EventIFN := 0; 923 AnOrderView.EventDelay.EventName := 'All Services, Active';*) 924 SelectOrderView(AnOrderView); 925 with AnOrderView do if Changed then 926 begin 927 FCurrentView.Assign(AnOrderView); 928 if FCurrentView.Filter in [15,16,17,24] then 929 begin 930 FCompress := False; 931 mnuActRel.Visible := True; 932 popOrderRel.Visible := True; 933 end else 934 begin 935 mnuActRel.Visible := False; 936 popOrderRel.Visible := False; 937 end; 938 939 //lstSheets.ItemIndex := -1; 940 lstSheets.Items[0] := 'C;0^' + FCurrentView.ViewName; // v27.5 - RV 941 942 lblWrite.Caption := 'Write Orders'; 943 lstWrite.Clear; 944 lstWrite.Caption := lblWrite.Caption; 945 LoadWriteOrders(lstWrite.Items); 946 RefreshOrderList(FROM_SERVER); 947 948 if ByService then 949 begin 950 if InvChrono then FDfltSort := OVS_CATINV else FDfltSort := OVS_CATFWD; 951 end else 952 begin 953 if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD; 954 end; 955 end; 956 finally 957 AnOrderView.free; 925 958 end; 926 959 end; … … 984 1017 AnOrderID := Piece(BigOrderID, ';', 1); 985 1018 if StrToIntDef(AnOrderID,0) = 0 then 986 ShowM essage('Detail view is not available for selected order.')1019 ShowMsg('Detail view is not available for selected order.') 987 1020 else 988 1021 begin 989 tmpList.Assign(DetailOrder(BigOrderID));1022 FastAssign(DetailOrder(BigOrderID), tmpList); 990 1023 if ((TOrder(Items.Objects[i]).DGroupName = 'Inpt. Meds') or 991 1024 (TOrder(Items.Objects[i]).DGroupName = 'Out. Meds') or 992 (TOrder(Items.Objects[i]).DGroupName = 'Clin .Orders') or1025 (TOrder(Items.Objects[i]).DGroupName = 'Clinic Orders') or 993 1026 (TOrder(Items.Objects[i]).DGroupName = 'Infusion')) then 994 1027 begin … … 996 1029 tmpList.Add(StringOfChar('=', 74)); 997 1030 tmpList.Add(''); 998 tmpList.AddStrings(MedAdminHistory(AnOrderID));1031 FastAddStrings(MedAdminHistory(AnOrderID), tmpList); 999 1032 end; 1000 1033 … … 1243 1276 end; 1244 1277 1278 procedure TfrmOrders.RightClickMessageHandler(var Msg: TMessage; 1279 var Handled: Boolean); 1280 begin 1281 if Msg.Msg = WM_RBUTTONUP then 1282 lstOrders.RightClickSelect := (lstOrders.SelCount < 1); 1283 end; 1284 1245 1285 function TfrmOrders.GetPlainText(AnOrder: TOrder; index: integer):string; 1246 1286 var … … 1254 1294 else 1255 1295 FirstColumnDisplayed := 1; 1256 for i:= FirstColumnDisplayed to 8do begin1296 for i:= FirstColumnDisplayed to 9 do begin 1257 1297 x := GetOrderText(AnOrder, index, i); 1258 1298 if x <> '' then … … 1297 1337 {measure height of start/stop times} 1298 1338 NewHeight := HigherOf(NewHeight, MeasureColumnHeight(AnOrder, Index, 3)); 1299 if NewHeight > 255 then NewHeight := 255; 1339 if NewHeight > 255 then NewHeight := 255; // This is maximum allowed by a Windows 1300 1340 if NewHeight < 13 then NewHeight := 13; 1301 1341 end; … … 1316 1356 1317 1357 function TfrmOrders.GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string; 1358 var 1359 AReason: TStringlist; 1360 i: integer; 1318 1361 begin 1319 1362 if AnOrder <> nil then with AnOrder do … … 1334 1377 result := Text; 1335 1378 if Flagged then 1336 result := result + ' *Flagged*'; 1379 begin 1380 if Notifications.Active then 1381 begin 1382 AReason := TStringList.Create; 1383 try 1384 result := result + crlf; 1385 LoadFlagReason(AReason, ID); 1386 for i := 0 to AReason.Count - 1 do 1387 result := result + AReason[i] + CRLF; 1388 finally 1389 AReason.Free; 1390 end; 1391 end 1392 else 1393 result := result + ' *Flagged*'; 1394 end; 1337 1395 end; 1338 1396 3: result := GetStartStopText( StartTime, StopTime); … … 1375 1433 end; 1376 1434 Canvas.FillRect(ARect); 1377 Canvas.Pen.Color := clSilver;1435 Canvas.Pen.Color := Get508CompliantColor(clSilver); 1378 1436 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); 1379 1437 Canvas.LineTo(ARect.Right, ARect.Bottom - 1); … … 1405 1463 if i = FirstColumnDisplayed then 1406 1464 begin 1407 if Flagged and (ColorToRGB(clWindowText) = ColorToRGB(clBlack))then1465 if Flagged then 1408 1466 begin 1409 Canvas.Brush.Color := clRed;1467 Canvas.Brush.Color := Get508CompliantColor(clRed); 1410 1468 Canvas.FillRect(ARect); 1411 1469 end; … … 1417 1475 if not (odSelected in State) and (AnOrder.Signature = OSS_UNSIGNED) then 1418 1476 begin 1419 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then 1420 Canvas.Font.Color := clBlue; 1477 if FHighContrast2Mode then 1478 Canvas.Font.Color := clBlue 1479 else 1480 Canvas.Font.Color := Get508CompliantColor(clBlue); 1421 1481 end; 1422 1482 end; … … 1435 1495 inherited; 1436 1496 FEvtColWidth := hdrOrders.Sections[0].Width; 1437 RedrawSuspend(Self.Handle);1438 1497 RedrawOrderList; 1439 RedrawActivate(Self.Handle);1440 1498 lstOrders.Invalidate; 1441 1499 pnlRight.Refresh; … … 1457 1515 NextIndex: Integer; 1458 1516 begin 1459 if PatientStatusChanged then exit; 1517 if OrderListClickProcessing then Exit; 1518 OrderListClickProcessing := true; //Make sure this gets set to false prior to exiting. 1519 //if PatientStatusChanged then exit; 1460 1520 if BILLING_AWARE then //CQ5114 1461 1521 fODConsult.displayDXCode := ''; //CQ5114 … … 1466 1526 NextIndex := lstWrite.ItemIndex; 1467 1527 if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then 1528 begin 1529 OrderListClickProcessing := false; 1468 1530 Exit; 1531 end; 1469 1532 if not ReadyForNewOrder(FCurrentView.EventDelay) then 1470 1533 begin 1471 1534 lstWrite.ItemIndex := RefNumFor(Self); 1535 OrderListClickProcessing := false; 1472 1536 Exit; 1473 1537 end; 1474 1538 1475 1539 // don't write delayed orders for non-VA meds: 1476 1540 if (FCurrentView.EventDelay.EventIFN>0) and (Piece(lstWrite.ItemID,';',2) = '145') then 1477 1541 begin 1478 1542 InfoBox('Delayed orders cannot be written for Non-VA Medications.', 'Meds, Non-VA', MB_OK); 1543 OrderListClickProcessing := false; 1479 1544 Exit; 1480 1545 end; … … 1488 1553 begin 1489 1554 lstWrite.ItemIndex := -1; 1555 OrderListClickProcessing := false; 1490 1556 Exit; 1491 1557 end; 1492 if frmFrame.CCOWDrivedChange then 1558 if frmFrame.CCOWDrivedChange then begin 1559 OrderListClickProcessing := false; 1493 1560 Exit; 1561 end; 1494 1562 PositionTopOrder(StrToIntDef(Piece(lstWrite.ItemID, ';', 3), 0)); // position Display Group 1495 1563 case CharAt(Piece(lstWrite.ItemID, ';', 4), 1) of … … 1517 1585 lstSheetsClick(Self); 1518 1586 end; 1587 OrderListClickProcessing := false; 1519 1588 if (FCurrentView <> nil) and (FCurrentView.EventDelay.PtEventIFN>0) and 1520 1589 (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then … … 1560 1629 begin 1561 1630 AnOrder := TOrder(Items.Objects[i]); 1631 if (AnAction = 'RN') and (PassDrugTest(StrtoINT(Piece(AnOrder.ID, ';',1)), 'E', True, True)=True) then 1632 begin 1633 ShowMsg('Cannot renew Clozapine orders.'); 1634 Selected[i] := false; 1635 end; 1562 1636 if (AnAction = 'RN') and (AnOrder.Status=6) and (AnOrder.DGroupName = 'Inpt. Meds') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then 1563 1637 begin … … 1570 1644 begin 1571 1645 if (AnAction = 'RN') then 1572 ShowM essage('The order contains invalid schedule and can not be renewed.')1646 ShowMsg('The order contains invalid schedule and can not be renewed.') 1573 1647 else if (AnAction = 'EV') then 1574 ShowM essage('The order contains invalid schedule and can not be changed to event delayed order.');1648 ShowMsg('The order contains invalid schedule and can not be changed to event delayed order.'); 1575 1649 1576 1650 Selected[i] := False; … … 1720 1794 //if CheckOrderStatus = True then Exit; 1721 1795 ValidateSelected(OA_DC, TX_NO_DC, TC_NO_DC); // validate DC action on each order 1722 //ActivateDeactiveRenew;AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE1796 ActivateDeactiveRenew; //AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE 1723 1797 MakeSelectedList(SelectedList); // build list of orders that remain 1724 1798 // updating the Changes object happens in ExecuteDCOrders, based on individual order … … 1748 1822 if not CanManualRelease then 1749 1823 begin 1750 ShowM essage('You are not authorized to manual release delayed orders.');1824 ShowMsg('You are not authorized to manual release delayed orders.'); 1751 1825 Exit; 1752 1826 end; … … 2085 2159 ChangeIFNList.Free; 2086 2160 end; 2161 if frmFrame.TimedOut then Exit; 2087 2162 RedrawOrderList; 2088 2163 end; … … 2281 2356 if (User.OrderRole <> 2) and (User.OrderRole <> 3) then 2282 2357 begin 2283 ShowM essage('Sorry, You don''t have the permission to release selected orders manually');2358 ShowMsg('Sorry, You don''t have the permission to release selected orders manually'); 2284 2359 Exit; 2285 2360 end; … … 2995 3070 if i > 0 then 2996 3071 IsDefaultDlg := False; 3072 2997 3073 ADest.ItemIndex := -1; 2998 3074 for j := 0 to ADest.Items.Count - 1 do … … 3107 3183 begin 3108 3184 inherited; 3109 if PatientStatusChanged then exit;3185 //if PatientStatusChanged then exit; 3110 3186 //frmFrame.UpdatePtInfoOnRefresh; 3111 3187 end; … … 3114 3190 begin 3115 3191 inherited; 3116 if PatientStatusChanged then exit;3192 //if PatientStatusChanged then exit; 3117 3193 //frmFrame.UpdatePtInfoOnRefresh; 3118 3194 end; … … 3121 3197 begin 3122 3198 inherited; 3123 if PatientStatusChanged then exit;3199 //if PatientStatusChanged then exit; 3124 3200 //frmFrame.UpdatePtInfoOnRefresh; 3125 3201 end; … … 3128 3204 begin 3129 3205 inherited; 3130 if PatientStatusChanged then exit;3206 //if PatientStatusChanged then exit; 3131 3207 //frmFrame.UpdatePtInfoOnRefresh; 3132 3208 end; … … 3273 3349 end; 3274 3350 3275 function TfrmOrders.PatientStatusChanged: boolean;3351 {function TfrmOrders.PatientStatusChanged: boolean; 3276 3352 const 3277 3353 … … 3302 3378 Result := True; 3303 3379 end; 3304 end; 3380 end;} 3305 3381 3306 3382 function TfrmOrders.CheckOrderStatus: boolean; … … 3308 3384 i: integer; 3309 3385 AnOrder: TOrder; 3386 OrderArray: TStringList; 3310 3387 begin 3311 3388 Result := False; 3389 OrderArray := TStringList.Create; 3312 3390 with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then 3313 3391 begin 3314 3392 AnOrder := TOrder(Items.Objects[i]); 3315 if AnORder.Status <> GetOrderStatus(AnOrder.ID) then 3316 begin 3317 MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0); 3318 frmFrame.mnuFileRefreshClick(Application); 3319 Result := True; 3320 EXIT; 3321 end; 3322 end; 3323 end; 3324 3325 (*procedure TfrmOrders.ActivateDeactiveRenew; 3393 OrderArray.Add(AnOrder.ID + U + InttoStr(AnOrder.Status)); 3394 end; 3395 if (OrderArray <> nil) and (not DoesOrderStatusMatch(OrderArray)) then 3396 begin 3397 MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0); 3398 frmFrame.mnuFileRefreshClick(Application); 3399 Result := True; 3400 end; 3401 ORderArray.Free; 3402 end; 3403 3404 procedure TfrmOrders.ActivateDeactiveRenew; 3326 3405 var 3327 3406 i: Integer; … … 3336 3415 end; 3337 3416 if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr); 3338 end; *)3417 end; 3339 3418 3340 3419 procedure TfrmOrders.ViewInfo(Sender: TObject); … … 3395 3474 end; 3396 3475 3476 initialization 3477 SpecifyFormIsNotADialog(TfrmOrders); 3478 3397 3479 end. 3398 3480 -
cprs/trunk/CPRS-Chart/Orders/fOrdersAlert.dfm
r456 r829 2 2 Left = 374 3 3 Top = 193 4 Height = 2785 4 Caption = 'Alert when Results Available' 5 ClientHeight = 251 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitWidth = 320 9 ExplicitHeight = 278 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 10 object Label1: TLabel 12 object Label1: TLabel [0] 11 13 Left = 8 12 14 Top = 8 … … 17 19 ' -' 18 20 end 19 object lblAlertRecipient: TLabel 21 object lblAlertRecipient: TLabel [1] 20 22 Left = 8 21 23 Top = 208 … … 24 26 Caption = 'Alert Recipient:' 25 27 end 26 object lstOrders: TCaptionListBox 28 object lstOrders: TCaptionListBox [2] 27 29 Left = 8 28 30 Top = 22 … … 35 37 ' -' 36 38 end 37 object cmdOK: TButton 39 object cmdOK: TButton [3] 38 40 Left = 267 39 41 Top = 222 … … 45 47 OnClick = cmdOKClick 46 48 end 47 object cmdCancel: TButton 49 object cmdCancel: TButton [4] 48 50 Left = 347 49 51 Top = 222 … … 55 57 OnClick = cmdCancelClick 56 58 end 57 object cboAlertRecipient: TORComboBox 59 object cboAlertRecipient: TORComboBox [5] 58 60 Left = 7 59 61 Top = 226 … … 79 81 OnExit = cboOnExit 80 82 OnNeedData = cboAlertRecipientNeedData 83 CharsNeedMatch = 1 84 end 85 inherited amgrMain: TVA508AccessibilityManager 86 Data = ( 87 ( 88 'Component = lstOrders' 89 'Status = stsDefault') 90 ( 91 'Component = cmdOK' 92 'Status = stsDefault') 93 ( 94 'Component = cmdCancel' 95 'Status = stsDefault') 96 ( 97 'Component = cboAlertRecipient' 98 'Status = stsDefault') 99 ( 100 'Component = frmAlertOrders' 101 'Status = stsDefault')) 81 102 end 82 103 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersAlert.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls ;7 fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOrdersCV.dfm
r456 r829 1 objectfrmChgEvent: TfrmChgEvent1 inherited frmChgEvent: TfrmChgEvent 2 2 Left = 256 3 3 Top = 148 4 Width = 5625 Height = 4286 4 Caption = 'Change Release Event' 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 = [] 5 ClientHeight = 401 6 ClientWidth = 554 13 7 OldCreateOrder = False 14 8 OnClose = FormClose 15 9 OnCreate = FormCreate 10 ExplicitWidth = 562 11 ExplicitHeight = 428 16 12 PixelsPerInch = 96 17 13 TextHeight = 13 18 object pnlTop: TPanel 14 object pnlTop: TPanel [0] 19 15 Left = 0 20 16 Top = 0 … … 27 23 Left = 1 28 24 Top = 1 29 Width = 55225 Width = 3 30 26 Height = 36 31 27 Align = alTop … … 36 32 end 37 33 end 38 object pnlBottom: TPanel 34 object pnlBottom: TPanel [1] 39 35 Left = 0 40 36 Top = 38 41 37 Width = 554 42 Height = 36 238 Height = 363 43 39 Align = alClient 44 40 TabOrder = 1 41 ExplicitHeight = 362 45 42 DesignSize = ( 46 43 554 47 36 2)44 363) 48 45 object cboSpecialty: TORComboBox 49 46 Left = 12 … … 69 66 OnChange = cboSpecialtyChange 70 67 OnDblClick = cboSpecialtyDblClick 68 CharsNeedMatch = 1 71 69 end 72 70 object btnCancel: TButton … … 92 90 end 93 91 end 92 inherited amgrMain: TVA508AccessibilityManager 93 Data = ( 94 ( 95 'Component = pnlTop' 96 'Status = stsDefault') 97 ( 98 'Component = pnlBottom' 99 'Status = stsDefault') 100 ( 101 'Component = cboSpecialty' 102 'Status = stsDefault') 103 ( 104 'Component = btnCancel' 105 'Status = stsDefault') 106 ( 107 'Component = btnAction' 108 'Status = stsDefault') 109 ( 110 'Component = frmChgEvent' 111 'Status = stsDefault')) 112 end 94 113 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersCV.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders; 7 StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders, 8 VA508AccessibilityManager; 8 9 9 10 type -
cprs/trunk/CPRS-Chart/Orders/fOrdersComplete.dfm
r456 r829 2 2 Left = 327 3 3 Top = 169 4 Height = 2845 4 Caption = 'Complete Orders' 5 ClientHeight = 257 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitWidth = 320 9 ExplicitHeight = 284 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 10 object Label1: TLabel 12 object Label1: TLabel [0] 11 13 Left = 8 12 14 Top = 8 … … 15 17 Caption = 'The following orders will be marked as complete -' 16 18 end 17 object lblESCode: TLabel 19 object lblESCode: TLabel [1] 18 20 Left = 8 19 21 Top = 214 … … 22 24 Caption = 'Electronic Signature Code' 23 25 end 24 object lstOrders: TCaptionListBox 26 object lstOrders: TCaptionListBox [2] 25 27 Left = 8 26 28 Top = 22 … … 31 33 Caption = 'The following orders will be marked as complete -' 32 34 end 33 object cmdOK: TButton 35 object cmdOK: TButton [3] 34 36 Left = 267 35 37 Top = 228 … … 41 43 OnClick = cmdOKClick 42 44 end 43 object cmdCancel: TButton 45 object cmdCancel: TButton [4] 44 46 Left = 347 45 47 Top = 228 … … 51 53 OnClick = cmdCancelClick 52 54 end 53 object txtESCode: TCaptionEdit 55 object txtESCode: TCaptionEdit [5] 54 56 Left = 8 55 57 Top = 228 … … 60 62 Caption = 'Electronic Signature Code' 61 63 end 64 inherited amgrMain: TVA508AccessibilityManager 65 Data = ( 66 ( 67 'Component = lstOrders' 68 'Status = stsDefault') 69 ( 70 'Component = cmdOK' 71 'Status = stsDefault') 72 ( 73 'Component = cmdCancel' 74 'Status = stsDefault') 75 ( 76 'Component = txtESCode' 77 'Status = stsDefault') 78 ( 79 'Component = frmCompleteOrders' 80 'Status = stsDefault')) 81 end 62 82 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersComplete.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls ;7 fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOrdersCopy.dfm
r456 r829 1 objectfrmCopyOrders: TfrmCopyOrders1 inherited frmCopyOrders: TfrmCopyOrders 2 2 Left = 319 3 3 Top = 139 4 AutoScroll = False5 4 Caption = 'Copy Orders' 6 5 ClientHeight = 419 7 6 ClientWidth = 441 8 Color = clBtnFace9 7 Constraints.MinHeight = 100 10 8 Constraints.MinWidth = 330 11 Font.Charset = DEFAULT_CHARSET12 Font.Color = clWindowText13 Font.Height = -1114 Font.Name = 'MS Sans Serif'15 Font.Style = []16 9 OldCreateOrder = True 17 10 OnCreate = FormCreate 18 OnKeyDown = FormKeyDown 11 ExplicitWidth = 449 12 ExplicitHeight = 446 19 13 PixelsPerInch = 96 20 14 TextHeight = 13 21 object pnl Info: TPanel15 object pnlRadio: TPanel [0] 22 16 Left = 0 23 Top = 4117 Top = 80 24 18 Width = 441 25 Height = 5019 Height = 65 26 20 Align = alTop 27 21 TabOrder = 1 28 object Image1: TImage29 Left = 130 Top = 131 Width = 2432 Height = 2233 AutoSize = True34 Enabled = False35 Picture.Data = {36 07544269746D61707E010000424D7E010000000000007600000028000000180037 000016000000010004000000000008010000C40E0000C40E000010000000000038 000000000000000080000080000000808000800000008000800080800000808039 8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF40 FF008000000000000000000000080777777777777777777777700F777777777741 7777777777700F88888888888888888887700F88888888888888888887700F8842 888808888888888887700F88888800888888888887700F8888880B088888888843 87700F8888880BB00008888887700F888800BBCCBBB0088887700F8880BBBCCC44 CBBBB08887700F880BBBBBBBBBBBBB0887700F880BBBBBCCBBBBBB0887700F8845 0BBBBBCCBBBBBB0887700F880BBBBBCCBBBBBB0887700F8880BBBBCCBBBBB08846 87700F888800BBBBBBB0088887700F88888800000008888887700F888888888847 8888888887700F88888888888888888887700FFFFFFFFFFFFFFFFFFFFF70800048 00000000000000000008}49 Transparent = True50 end51 object Label2: TStaticText52 Left = 3153 Top = 3054 Width = 36555 Height = 1756 Caption =57 'Use Transfer: if inpatient will move from one ward or treating t' +58 'eam to another.'59 TabOrder = 160 TabStop = True61 end62 object Label1: TStaticText63 Left = 3164 Top = 465 Width = 33166 Height = 1767 Caption =68 'Use Admit: if patient is newly admitted to the hospital or nursi' +69 'ng home.'70 TabOrder = 071 TabStop = True72 end73 end74 inline fraEvntDelayList: TfraEvntDelayList75 Left = 076 Top = 15477 Width = 44178 Height = 26579 Align = alClient80 TabOrder = 381 Visible = False82 inherited pnlDate: TPanel83 Left = 33684 Height = 26585 inherited lblEffective: TLabel86 Left = 45187 end88 inherited orDateBox: TORDateBox89 Left = 45190 end91 end92 inherited pnlList: TPanel93 Width = 33694 Height = 26595 inherited lblEvntDelayList: TLabel96 Width = 33497 end98 inherited mlstEvents: TORListBox99 Width = 334100 Height = 229101 OnDblClick = cmdOKClick102 OnChange = fraEvntDelayListmlstEventsChange103 end104 inherited edtSearch: TCaptionEdit105 Width = 334106 end107 end108 end109 object pnlRadio: TPanel110 Left = 0111 Top = 91112 Width = 441113 Height = 63114 Align = alTop115 TabOrder = 2116 22 object GroupBox1: TGroupBox 117 23 Left = 1 118 24 Top = 1 119 25 Width = 439 120 Height = 6 126 Height = 63 121 27 Align = alClient 122 28 Constraints.MinHeight = 50 … … 143 49 OnClick = radEvtDelayClick 144 50 end 145 end 146 end 147 object pnlTop: TPanel 51 object cmdOK: TButton 52 Left = 345 53 Top = 14 54 Width = 72 55 Height = 19 56 Caption = 'OK' 57 Constraints.MaxWidth = 73 58 Default = True 59 TabOrder = 2 60 OnClick = cmdOKClick 61 end 62 object cmdCancel: TButton 63 Left = 345 64 Top = 38 65 Width = 72 66 Height = 18 67 Cancel = True 68 Caption = 'Cancel' 69 Constraints.MaxWidth = 73 70 TabOrder = 3 71 OnClick = cmdCancelClick 72 end 73 end 74 end 75 object pnlTop: TPanel [1] 148 76 Left = 0 149 77 Top = 0 150 78 Width = 441 151 Height = 4179 Height = 80 152 80 Align = alTop 153 81 BevelOuter = bvNone 154 82 TabOrder = 0 155 object lblPtInfo: TStaticText 83 object lblPtInfo: TVA508StaticText 84 Name = 'lblPtInfo' 156 85 Left = 0 157 Top = 0 86 Top = 5 87 Width = 400 88 Height = 35 89 Alignment = taLeftJustify 90 AutoSize = True 91 Caption = ' ' 92 Constraints.MinHeight = 15 93 TabOrder = 0 94 ShowAccelChar = True 95 end 96 object pnlInfo: TPanel 97 Left = 0 98 Top = 46 158 99 Width = 441 159 Height = 41 160 Align = alTop 161 Anchors = [akLeft, akTop, akRight, akBottom] 162 AutoSize = False 163 Constraints.MinHeight = 40 100 Height = 34 101 Align = alBottom 102 TabOrder = 1 103 object Image1: TImage 104 Left = 1 105 Top = 1 106 Width = 24 107 Height = 22 108 AutoSize = True 109 Enabled = False 110 Picture.Data = { 111 07544269746D61707E010000424D7E0100000000000076000000280000001800 112 000016000000010004000000000008010000C40E0000C40E0000100000000000 113 0000000000000000800000800000008080008000000080008000808000008080 114 8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF 115 FF008000000000000000000000080777777777777777777777700F7777777777 116 7777777777700F88888888888888888887700F88888888888888888887700F88 117 888808888888888887700F88888800888888888887700F8888880B0888888888 118 87700F8888880BB00008888887700F888800BBCCBBB0088887700F8880BBBCCC 119 CBBBB08887700F880BBBBBBBBBBBBB0887700F880BBBBBCCBBBBBB0887700F88 120 0BBBBBCCBBBBBB0887700F880BBBBBCCBBBBBB0887700F8880BBBBCCBBBBB088 121 87700F888800BBBBBBB0088887700F88888800000008888887700F8888888888 122 8888888887700F88888888888888888887700FFFFFFFFFFFFFFFFFFFFF708000 123 00000000000000000008} 124 Transparent = True 125 end 126 object lblInstruction2: TVA508StaticText 127 Name = 'lblInstruction2' 128 Left = 31 129 Top = 17 130 Width = 363 131 Height = 15 132 Alignment = taLeftJustify 133 Caption = 134 'Use Transfer: if inpatient will move from one ward or treating t' + 135 'eam to another.' 136 TabOrder = 1 137 ShowAccelChar = True 138 end 139 object lblInstruction: TVA508StaticText 140 Name = 'lblInstruction' 141 Left = 31 142 Top = 1 143 Width = 329 144 Height = 15 145 Alignment = taLeftJustify 146 Caption = 147 'Use Admit: if patient is newly admitted to the hospital or nursi' + 148 'ng home.' 149 TabOrder = 0 150 ShowAccelChar = True 151 end 152 end 153 end 154 object pnlBottom: TPanel [2] 155 Left = 0 156 Top = 145 157 Width = 441 158 Height = 274 159 Align = alClient 160 TabOrder = 2 161 ExplicitLeft = 8 162 ExplicitTop = 165 163 ExplicitWidth = 425 164 ExplicitHeight = 236 165 inline fraEvntDelayList: TfraEvntDelayList 166 Left = 1 167 Top = 1 168 Width = 439 169 Height = 272 170 Align = alBottom 171 AutoScroll = True 164 172 TabOrder = 0 165 173 TabStop = True 166 end 167 end 168 object pnlBtns: TPanel 169 Left = 334 170 Top = 91 171 Width = 107 172 Height = 63 173 Align = alCustom 174 Anchors = [akTop, akRight] 175 TabOrder = 4 176 object gbBtns: TGroupBox 177 Left = 1 178 Top = 1 179 Width = 105 180 Height = 61 181 Align = alClient 182 TabOrder = 0 183 DesignSize = ( 184 105 185 61) 186 object cmdOK: TButton 187 Left = 17 188 Top = 13 189 Width = 72 190 Height = 19 191 Anchors = [akTop, akRight] 192 Caption = 'OK' 193 Constraints.MaxWidth = 73 194 Default = True 195 TabOrder = 0 196 OnClick = cmdOKClick 197 end 198 object cmdCancel: TButton 199 Left = 17 200 Top = 34 201 Width = 72 202 Height = 18 203 Anchors = [akRight, akBottom] 204 Cancel = True 205 Caption = 'Cancel' 206 Constraints.MaxWidth = 73 207 TabOrder = 1 208 OnClick = cmdCancelClick 209 end 210 end 174 Visible = False 175 ExplicitTop = 145 176 ExplicitWidth = 441 177 ExplicitHeight = 274 178 inherited pnlDate: TPanel 179 Left = 334 180 Height = 272 181 ExplicitLeft = 336 182 ExplicitHeight = 274 183 inherited lblEffective: TLabel 184 Left = 451 185 Width = 71 186 ExplicitLeft = 451 187 ExplicitWidth = 71 188 end 189 inherited orDateBox: TORDateBox 190 Left = 451 191 ExplicitLeft = 451 192 end 193 end 194 inherited pnlList: TPanel 195 Width = 334 196 Height = 272 197 ExplicitWidth = 336 198 ExplicitHeight = 274 199 inherited lblEvntDelayList: TLabel 200 Width = 332 201 ExplicitWidth = 80 202 end 203 inherited mlstEvents: TORListBox 204 Width = 332 205 Height = 236 206 OnDblClick = cmdOKClick 207 OnChange = fraEvntDelayListmlstEventsChange 208 ExplicitWidth = 334 209 ExplicitHeight = 238 210 end 211 inherited edtSearch: TCaptionEdit 212 Width = 332 213 ExplicitWidth = 334 214 end 215 end 216 end 217 end 218 inherited amgrMain: TVA508AccessibilityManager 219 Data = ( 220 ( 221 'Component = pnlInfo' 222 'Status = stsDefault') 223 ( 224 'Component = lblInstruction2' 225 'Status = stsDefault') 226 ( 227 'Component = lblInstruction' 228 'Status = stsDefault') 229 ( 230 'Component = fraEvntDelayList' 231 'Status = stsDefault') 232 ( 233 'Component = fraEvntDelayList.pnlDate' 234 'Status = stsDefault') 235 ( 236 'Component = fraEvntDelayList.orDateBox' 237 'Status = stsDefault') 238 ( 239 'Component = fraEvntDelayList.pnlList' 240 'Status = stsDefault') 241 ( 242 'Component = fraEvntDelayList.mlstEvents' 243 'Status = stsDefault') 244 ( 245 'Component = fraEvntDelayList.edtSearch' 246 'Status = stsDefault') 247 ( 248 'Component = pnlRadio' 249 'Status = stsDefault') 250 ( 251 'Component = GroupBox1' 252 'Status = stsDefault') 253 ( 254 'Component = radRelease' 255 'Status = stsDefault') 256 ( 257 'Component = radEvtDelay' 258 'Status = stsDefault') 259 ( 260 'Component = pnlTop' 261 'Status = stsDefault') 262 ( 263 'Component = lblPtInfo' 264 'Status = stsDefault') 265 ( 266 'Component = frmCopyOrders' 267 'Status = stsDefault') 268 ( 269 'Component = cmdOK' 270 'Status = stsDefault') 271 ( 272 'Component = cmdCancel' 273 'Status = stsDefault') 274 ( 275 'Component = pnlBottom' 276 'Status = stsDefault')) 211 277 end 212 278 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersCopy.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz; 7 StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmCopyOrders = class(T Form)11 TfrmCopyOrders = class(TfrmBase508Form) 11 12 pnlInfo: TPanel; 12 13 fraEvntDelayList: TfraEvntDelayList; … … 16 17 radEvtDelay: TRadioButton; 17 18 Image1: TImage; 18 Label2: TStaticText;19 Label1: TStaticText;19 lblInstruction2: TVA508StaticText; 20 lblInstruction: TVA508StaticText; 20 21 pnlTop: TPanel; 21 lblPtInfo: TStaticText; 22 pnlBtns: TPanel; 23 gbBtns: TGroupBox; 22 lblPtInfo: TVA508StaticText; 24 23 cmdOK: TButton; 25 24 cmdCancel: TButton; 25 pnlBottom: TPanel; 26 26 procedure cmdOKClick(Sender: TObject); 27 27 procedure cmdCancelClick(Sender: TObject); … … 37 37 private 38 38 OKPressed: Boolean; 39 procedure AdjustFormSize; 39 40 public 40 41 end; … … 116 117 frmCopyOrders := TfrmCopyOrders.Create(Application); 117 118 try 118 ResizeFormToFont(TForm(frmCopyOrders)); 119 ResizeAnchoredFormToFont(TForm(frmCopyOrders)); 120 frmCopyOrders.AdjustFormSize; 119 121 CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1); 120 122 if Length(CurrTS)>0 then … … 132 134 frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap; 133 135 end; 136 frmCopyOrders.AdjustFormSize; 134 137 frmCopyOrders.ShowModal; 135 138 if (frmCopyOrders.OKPressed) and (frmCopyOrders.radRelease.Checked) then … … 234 237 begin 235 238 pnlInfo.Visible := False; 236 pnlBtns.Top := pnlRadio.Top; 237 end; 238 if not radEvtDelay.Checked then 239 begin 240 if not pnlInfo.Visible then 241 Height := Height - fraEvntDelayList.Height - pnlInfo.Height 242 else 243 Height := Height - fraEvntDelayList.Height; 244 end; 239 end; 240 AdjustFormSize; 245 241 end; 246 242 … … 263 259 end; 264 260 261 procedure TfrmCopyOrders.AdjustFormSize; 262 var 263 y: integer; 264 begin 265 y := lblPtInfo.Height + 8; // allow for font changes 266 if pnlInfo.Visible then 267 begin 268 lblInstruction2.top := lblInstruction.Height; // allow for font change 269 pnlInfo.Height := lblInstruction2.top + lblInstruction2.Height; 270 inc(y,pnlInfo.Height); 271 end; 272 pnlTop.Height := y; 273 inc(y, pnlRadio.Height); 274 if fraEvntDelayList.Visible then 275 begin 276 inc(y, fraEvntDelayList.Height); 277 end; 278 VertScrollBar.Range := y; 279 ClientHeight := y; 280 end; 281 265 282 procedure TfrmCopyOrders.cmdCancelClick(Sender: TObject); 266 283 begin … … 275 292 radRelease.Checked := False; 276 293 radEvtDelay.Checked := True; 277 Height := Height + fraEvntDelayList.Height;278 294 fraEvntDelayList.Visible := True; 279 295 frmCopyOrders.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0); 280 296 fraEvntDelayList.DisplayEvntDelayList; 297 AdjustFormSize; 281 298 end; 282 299 … … 288 305 radRelease.Checked := True; 289 306 fraEvntDelayList.Visible := False; 290 Height := Height - fraEvntDelayList.Height;307 AdjustFormSize; 291 308 end; 292 309 … … 327 344 Shift: TShiftState); 328 345 begin 346 inherited; 329 347 if Key = VK_RETURN then 330 348 cmdOKClick(Self); -
cprs/trunk/CPRS-Chart/Orders/fOrdersDC.dfm
r456 r829 2 2 Left = 316 3 3 Top = 226 4 Width = 4335 Height = 3166 4 Caption = 'Discontinue / Cancel Orders' 5 ClientHeight = 289 6 ClientWidth = 425 7 7 Position = poScreenCenter 8 8 OnCreate = FormCreate 9 ExplicitLeft = 316 10 ExplicitTop = 226 11 ExplicitWidth = 433 12 ExplicitHeight = 323 9 13 PixelsPerInch = 96 10 14 TextHeight = 13 11 object Label1: TLabel 15 object Label1: TLabel [0] 12 16 Left = 0 13 17 Top = 0 … … 17 21 Caption = 'The following orders will be discontinued -' 18 22 WordWrap = True 23 ExplicitWidth = 196 19 24 end 20 object Panel1: TPanel 25 object Panel1: TPanel [1] 21 26 Left = 0 22 27 Top = 13 … … 39 44 end 40 45 end 41 object Panel2: TPanel 46 object Panel2: TPanel [2] 42 47 Left = 0 43 48 Top = 201 … … 45 50 Height = 88 46 51 Align = alBottom 52 Constraints.MinHeight = 88 47 53 TabOrder = 1 48 54 DesignSize = ( … … 56 62 Align = alTop 57 63 Caption = 'Reason for Discontinue (select one)' 64 ExplicitWidth = 169 58 65 end 59 66 object lstReason: TORListBox … … 65 72 ParentShowHint = False 66 73 ShowHint = True 67 Sorted = True68 74 TabOrder = 0 69 75 Caption = 'Reason for Discontinue (select one)' … … 77 83 Width = 72 78 84 Height = 21 79 Anchors = [ak Left, akBottom]85 Anchors = [akRight, akBottom] 80 86 Caption = 'OK' 81 87 Default = True … … 95 101 end 96 102 end 103 inherited amgrMain: TVA508AccessibilityManager 104 Data = ( 105 ( 106 'Component = Panel1' 107 'Status = stsDefault') 108 ( 109 'Component = lstOrders' 110 'Status = stsDefault') 111 ( 112 'Component = Panel2' 113 'Status = stsDefault') 114 ( 115 'Component = lstReason' 116 'Status = stsDefault') 117 ( 118 'Component = cmdOK' 119 'Status = stsDefault') 120 ( 121 'Component = cmdCancel' 122 'Status = stsDefault') 123 ( 124 'Component = frmDCOrders' 125 'Status = stsDefault')) 126 end 97 127 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersDC.pas
r456 r829 4 4 5 5 uses 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls ;6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fBase508Form, 7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, ORNet, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmDCOrders = class(Tfrm AutoSz)10 TfrmDCOrders = class(TfrmBase508Form) 11 11 Label1: TLabel; 12 12 Panel1: TPanel; … … 24 24 procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer; 25 25 var AHeight: Integer); 26 procedure FormDestroy(Sender: TObject); 27 procedure unMarkedOrignalOrderDC(OrderArr: TStringList); 26 28 private 27 29 OKPressed: Boolean; 28 30 DCReason: Integer; 29 function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer; 31 function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer; 32 public 33 OrderIDArr: TStringList; 30 34 end; 31 35 … … 46 50 frmDCOrders: TfrmDCOrders; 47 51 AnOrder: TOrder; 48 i, CanSign, DCType: Integer;49 NeedReason,NeedRefresh,OnCurrent : Boolean;52 i, j, CanSign, DCType: Integer; 53 NeedReason,NeedRefresh,OnCurrent, DCNewOrder: Boolean; 50 54 OriginalID,APtEvtID,APtEvtName,AnEvtInfo,tmpPtEvt: string; 51 55 PtEvtList: TStringList; 56 DCChangeItem: TChangeItem; 52 57 begin 53 58 Result := False; … … 55 60 OnCurrent := False; 56 61 NeedRefresh := False; 62 DCNewOrder := false; 57 63 PtEvtList := TStringList.Create; 58 64 if SelectedList.Count = 0 then Exit; … … 65 71 AnOrder := TOrder(Items[i]); 66 72 frmDCOrders.lstOrders.Items.Add(AnOrder.Text); 73 frmDCOrders.OrderIDArr.Add(AnOrder.ID); 67 74 if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True; 75 if (NeedReason = True) and (AnOrder.Status = 10) and (AnOrder.Signature = 2) then NeedReason := False; 76 68 77 end; 69 78 if NeedReason then … … 87 96 OriginalID := AnOrder.ID; 88 97 PtEvtList.Add(AnOrder.EventPtr + '^' + AnOrder.EventName); 89 DCOrder(AnOrder, frmDCOrders.DCReason, DCType); 98 if Changes.Orders.Count = 0 then DCNewOrder := false 99 else 100 begin 101 for j := 0 to Changes.Orders.Count - 1 do 102 begin 103 DCChangeItem := TChangeItem(Changes.Orders.Items[j]); 104 if DCChangeItem.ID = AnOrder.ID then 105 begin 106 if (Pos('DC', AnOrder.ActionOn) = 0) then 107 DCNewOrder := True 108 else DCNewOrder := False; 109 end; 110 end; 111 end; 112 DCOrder(AnOrder, frmDCOrders.DCReason, DCNewOrder, DCType); 90 113 case DCType of 91 114 DCT_NEWORDER: begin 92 Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID );115 Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID, user.DUZ, AnOrder.DGroupName, True); 93 116 AnOrder.ActionOn := OriginalID + '=DC'; 94 117 end; … … 150 173 inherited; 151 174 OKPressed := False; 175 OrderIDArr := TStringList.Create; 152 176 ListDCReasons(lstReason.Items, DefaultIEN); 153 177 lstReason.SelectByIEN(DefaultIEN); … … 179 203 begin 180 204 inherited; 205 unMarkedOrignalOrderDC(Self.OrderIDArr); 181 206 Close; 182 207 end; … … 194 219 begin 195 220 Canvas.FillRect(ARect); 196 Canvas.Pen.Color := clSilver;221 Canvas.Pen.Color := Get508CompliantColor(clSilver); 197 222 Canvas.MoveTo(0, ARect.Bottom - 1); 198 223 Canvas.LineTo(ARect.Right, ARect.Bottom - 1); … … 230 255 end; 231 256 257 procedure TfrmDCOrders.FormDestroy(Sender: TObject); 258 begin 259 inherited; 260 if self.OrderIDArr <> nil then self.OrderIDArr.Free; 261 end; 262 263 procedure TfrmDCOrders.unMarkedOrignalOrderDC(OrderArr: TStringList); 264 begin 265 CallV('ORWDX1 UNDCORIG', [OrderArr]); 266 end; 267 232 268 end. -
cprs/trunk/CPRS-Chart/Orders/fOrdersEvntRelease.dfm
r456 r829 1 objectfrmOrdersEvntRelease: TfrmOrdersEvntRelease1 inherited frmOrdersEvntRelease: TfrmOrdersEvntRelease 2 2 Left = 196 3 3 Top = 66 4 Width = 4515 Height = 3556 4 Caption = 'Auto DC/Release Event Orders' 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 = [] 5 ClientHeight = 328 6 ClientWidth = 443 13 7 OldCreateOrder = False 14 8 OnClose = FormClose 15 9 OnCreate = FormCreate 16 OnDestroy = FormDestroy17 10 OnShow = FormShow 11 ExplicitWidth = 451 12 ExplicitHeight = 355 18 13 PixelsPerInch = 96 19 14 TextHeight = 13 20 object pnlTop: TPanel 15 object pnlTop: TPanel [0] 21 16 Left = 0 22 17 Top = 0 … … 73 68 Position = 5 74 69 TabOrder = 1 75 Wrap = False76 70 OnClick = updown1Click 77 71 end … … 100 94 Left = 1 101 95 Top = 1 102 Width = 2 9096 Width = 244 103 97 Height = 13 104 98 Align = alTop … … 109 103 Left = 1 110 104 Top = 14 111 Width = 290105 Width = 156 112 106 Height = 13 113 107 Align = alTop … … 117 111 end 118 112 end 119 object pnlBottom: TPanel 113 object pnlBottom: TPanel [1] 120 114 Left = 0 121 115 Top = 85 … … 184 178 end 185 179 end 180 inherited amgrMain: TVA508AccessibilityManager 181 Data = ( 182 ( 183 'Component = pnlTop' 184 'Status = stsDefault') 185 ( 186 'Component = lblPtInfo' 187 'Status = stsDefault') 188 ( 189 'Component = Panel1' 190 'Status = stsDefault') 191 ( 192 'Component = Panel2' 193 'Status = stsDefault') 194 ( 195 'Component = btnApply' 196 'Status = stsDefault') 197 ( 198 'Component = updown1' 199 'Status = stsDefault') 200 ( 201 'Component = edtNumber' 202 'Status = stsDefault') 203 ( 204 'Component = Panel3' 205 'Status = stsDefault') 206 ( 207 'Component = pnlBottom' 208 'Status = stsDefault') 209 ( 210 'Component = btnOK' 211 'Status = stsDefault') 212 ( 213 'Component = btnCancel' 214 'Status = stsDefault') 215 ( 216 'Component = grdEvtList' 217 'Status = stsDefault') 218 ( 219 'Component = frmOrdersEvntRelease' 220 'Status = stsDefault')) 221 end 186 222 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersEvntRelease.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs 7 7 ,ORFn, uCore, rOrders, fOrders, StdCtrls, ORCtrls, ExtCtrls, Grids,fAutoSz, 8 Spin, ComCtrls ;8 Spin, ComCtrls, VA508AccessibilityManager; 9 9 10 10 type … … 45 45 procedure updown1Click(Sender: TObject; Button: TUDBtnType); 46 46 procedure FormClose(Sender: TObject; var Action: TCloseAction); 47 procedure FormDestroy(Sender: TObject);48 47 private 49 48 { Private declarations } … … 65 64 implementation 66 65 67 uses rMisc, Accessibility_TLB, uAccessibleStringGrid;66 uses rMisc, VAUtils; 68 67 69 68 {$R *.DFM} … … 148 147 grdEvtList.Cells[1,0] := 'Date/Time Occured'; 149 148 SetPtEvtList(TStrings(fevtList),Patient.DFN, ATotal); 150 TAccessibleStringGrid.WrapControl(grdEvtList);151 149 end; 152 150 … … 200 198 if grdEvtList.Row < 1 then 201 199 begin 202 ShowM essage('You need to select an event first.');200 ShowMsg('You need to select an event first.'); 203 201 FOkPressed := False; 204 202 Exit; … … 363 361 end; 364 362 365 procedure TfrmOrdersEvntRelease.FormDestroy(Sender: TObject);366 begin367 TAccessibleStringGrid.UnwrapControl(grdEvtList);368 inherited;369 end;370 371 363 end. -
cprs/trunk/CPRS-Chart/Orders/fOrdersHold.dfm
r456 r829 2 2 Left = 386 3 3 Top = 413 4 Height = 2705 4 Caption = 'Hold Orders' 5 ClientHeight = 243 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitWidth = 320 9 ExplicitHeight = 270 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 10 object Label1: TLabel 12 object Label1: TLabel [0] 11 13 Left = 8 12 14 Top = 8 … … 15 17 Caption = 'The following orders will be placed on hold -' 16 18 end 17 object lstOrders: TCaptionListBox 19 object lstOrders: TCaptionListBox [1] 18 20 Left = 8 19 21 Top = 22 … … 24 26 Caption = 'The following orders will be placed on hold -' 25 27 end 26 object cmdOK: TButton 28 object cmdOK: TButton [2] 27 29 Left = 267 28 30 Top = 214 … … 34 36 OnClick = cmdOKClick 35 37 end 36 object cmdCancel: TButton 38 object cmdCancel: TButton [3] 37 39 Left = 347 38 40 Top = 214 … … 44 46 OnClick = cmdCancelClick 45 47 end 48 inherited amgrMain: TVA508AccessibilityManager 49 Data = ( 50 ( 51 'Component = lstOrders' 52 'Status = stsDefault') 53 ( 54 'Component = cmdOK' 55 'Status = stsDefault') 56 ( 57 'Component = cmdCancel' 58 'Status = stsDefault') 59 ( 60 'Component = frmHoldOrders' 61 'Status = stsDefault')) 62 end 46 63 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersHold.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls ;7 fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOrdersOnChart.dfm
r456 r829 2 2 Left = 292 3 3 Top = 149 4 Width = 4705 Height = 3686 4 Caption = 'Signature on Chart' 5 ClientHeight = 341 6 ClientWidth = 462 7 7 Position = poScreenCenter 8 8 OnCreate = FormCreate 9 ExplicitWidth = 470 10 ExplicitHeight = 368 9 11 PixelsPerInch = 96 10 12 TextHeight = 13 11 object Panel2: TPanel 13 object Panel2: TPanel [0] 12 14 Left = 0 13 15 Top = 0 … … 28 30 'ed -' 29 31 Layout = tlBottom 32 ExplicitWidth = 318 30 33 end 31 34 object lstOrders: TCaptionListBox … … 47 50 end 48 51 end 49 object Panel1: TPanel 52 object Panel1: TPanel [1] 50 53 Left = 0 51 54 Top = 305 … … 80 83 end 81 84 end 85 inherited amgrMain: TVA508AccessibilityManager 86 Data = ( 87 ( 88 'Component = Panel2' 89 'Status = stsDefault') 90 ( 91 'Component = lstOrders' 92 'Status = stsDefault') 93 ( 94 'Component = Panel1' 95 'Status = stsDefault') 96 ( 97 'Component = cmdOK' 98 'Status = stsDefault') 99 ( 100 'Component = cmdCancel' 101 'Status = stsDefault') 102 ( 103 'Component = frmOnChartOrders' 104 'Status = stsDefault')) 105 end 82 106 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersOnChart.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls ;7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager; 8 8 9 9 type … … 34 34 35 35 uses rCore, rOrders, uConst, fOrdersPrint, uOrders, fFrame, UCore, 36 fClinicWardMeds ;36 fClinicWardMeds, rODLab, fRptBox; 37 37 38 38 const … … 47 47 SignList: TStringList; 48 48 OrderText: string; 49 AList: TStringList; 49 50 50 51 function FindOrderText(const AnID: string): string; … … 97 98 begin 98 99 OrderText := FindOrderText(Piece(SignList[i], U, 1)); 100 if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then 101 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF + 102 'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.', 103 TC_SAVERR, MB_OK) 104 else 99 105 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, 100 106 TC_SAVERR, MB_OK); … … 102 108 end; 103 109 StatusText(''); 110 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders 111 AList := TStringList.Create; 112 try 113 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList); 114 if AList.Text <> '' then 115 ReportBox(AList, 'Changed Orders', TRUE); 116 finally 117 AList.Free; 118 end; 104 119 PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc); 105 120 // SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt); //*KCM* … … 147 162 x := FilteredString(Items[Index]); 148 163 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect); 149 //if AHeight > 255 then AHeight := 255;150 164 if AHeight < 13 then AHeight := 15; 151 165 end; … … 165 179 ARect.Left := ARect.Left + 2; 166 180 Canvas.FillRect(ARect); 167 Canvas.Pen.Color := clSilver;181 Canvas.Pen.Color := Get508CompliantColor(clSilver); 168 182 SaveColor := Canvas.Brush.Color; 169 183 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); -
cprs/trunk/CPRS-Chart/Orders/fOrdersPrint.dfm
r456 r829 1 objectfrmOrdersPrint: TfrmOrdersPrint1 inherited frmOrdersPrint: TfrmOrdersPrint 2 2 Left = 353 3 3 Top = 194 4 Width = 3645 Height = 3156 4 Caption = 'Print orders' 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 = 288 6 ClientWidth = 356 14 7 OldCreateOrder = True 15 8 Position = poScreenCenter … … 17 10 PixelsPerInch = 96 18 11 TextHeight = 13 19 object pnlBase: TORAutoPanel 12 object pnlBase: TORAutoPanel [0] 20 13 Left = 0 21 14 Top = 0 … … 222 215 end 223 216 end 217 inherited amgrMain: TVA508AccessibilityManager 218 Data = ( 219 ( 220 'Component = pnlBase' 221 'Status = stsDefault') 222 ( 223 'Component = lblPartOne' 224 'Status = stsDefault') 225 ( 226 'Component = lblPart2' 227 'Status = stsDefault') 228 ( 229 'Component = ckChartCopy' 230 'Status = stsDefault') 231 ( 232 'Component = ckLabels' 233 'Status = stsDefault') 234 ( 235 'Component = ckRequisitions' 236 'Status = stsDefault') 237 ( 238 'Component = ckWorkCopy' 239 'Status = stsDefault') 240 ( 241 'Component = lstChartDevice' 242 'Status = stsDefault') 243 ( 244 'Component = lstLabelDevice' 245 'Status = stsDefault') 246 ( 247 'Component = lstReqDevice' 248 'Status = stsDefault') 249 ( 250 'Component = lstWorkDevice' 251 'Status = stsDefault') 252 ( 253 'Component = cmdChart' 254 'Status = stsDefault') 255 ( 256 'Component = cmdLabels' 257 'Status = stsDefault') 258 ( 259 'Component = cmdReqs' 260 'Status = stsDefault') 261 ( 262 'Component = cmdWork' 263 'Status = stsDefault') 264 ( 265 'Component = cmdOK' 266 'Status = stsDefault') 267 ( 268 'Component = cmdCancel' 269 'Status = stsDefault') 270 ( 271 'Component = frmOrdersPrint' 272 'Status = stsDefault')) 273 end 224 274 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersPrint.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORCtrls, ORfn, ExtCtrls, rOrders, fFrame; 7 StdCtrls, ORCtrls, ORfn, ExtCtrls, rOrders, fFrame, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmOrdersPrint = class(T Form)11 TfrmOrdersPrint = class(TfrmBase508Form) 11 12 ckChartCopy: TCheckBox; 12 13 ckLabels: TCheckBox; … … 59 60 NO_WIN_PRINT = False; 60 61 61 procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean); 62 procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean; 63 PrintTitle: string = ''; PrintLoc: Integer = 0); 62 64 63 65 implementation … … 68 70 fDeviceSelect, uCore, ORNet, fOrders; 69 71 70 procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean); 72 procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean; 73 PrintTitle: string = ''; PrintLoc: Integer = 0); 71 74 {displays device and copy selection form for printing orders, and returns a record of the selections} 72 75 var … … 74 77 begin 75 78 frmOrdersPrint := TfrmOrdersPrint.Create(Application); 79 if PrintTitle <> '' then frmOrdersPrint.Caption := 'Print Orders for ' + PrintTitle; 76 80 try 77 81 frmFrame.CCOWBusy := True; … … 87 91 lblPart2.Text := 'Greyed out items are not available.'; 88 92 end; 89 OrderPrintDeviceInfo(OrderList, PrintParams, Nature );93 OrderPrintDeviceInfo(OrderList, PrintParams, Nature, PrintLoc); 90 94 SetupControls(PrintParams); 91 95 if (PrintParams.AnyPrompts) {or FSelectAll} then ShowModal; -
cprs/trunk/CPRS-Chart/Orders/fOrdersRefill.dfm
r456 r829 1 objectfrmRefillOrders: TfrmRefillOrders1 inherited frmRefillOrders: TfrmRefillOrders 2 2 Left = 181 3 3 Top = 267 4 Width = 4355 Height = 3116 4 Caption = 'Refill Orders' 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 OldCreateOrder = True 5 ClientHeight = 284 14 6 OnClose = FormClose 15 7 OnCreate = FormCreate 16 8 OnShow = FormShow 9 ExplicitHeight = 311 17 10 PixelsPerInch = 96 18 11 TextHeight = 13 19 object pnlBottom: TPanel 12 object pnlBottom: TPanel [0] 20 13 Left = 0 21 14 Top = 200 … … 80 73 end 81 74 end 82 object pnlClient: TPanel 75 object pnlClient: TPanel [1] 83 76 Left = 0 84 77 Top = 0 … … 91 84 Left = 0 92 85 Top = 0 93 Width = 42794 Height = 1 786 Width = 181 87 Height = 13 95 88 Align = alTop 96 89 Caption = 'Request refills for the following orders -' … … 107 100 end 108 101 end 102 inherited amgrMain: TVA508AccessibilityManager 103 Data = ( 104 ( 105 'Component = pnlBottom' 106 'Status = stsDefault') 107 ( 108 'Component = cmdOK' 109 'Status = stsDefault') 110 ( 111 'Component = cmdCancel' 112 'Status = stsDefault') 113 ( 114 'Component = grbPickUp' 115 'Status = stsDefault') 116 ( 117 'Component = radWindow' 118 'Status = stsDefault') 119 ( 120 'Component = radMail' 121 'Status = stsDefault') 122 ( 123 'Component = radClinic' 124 'Status = stsDefault') 125 ( 126 'Component = pnlClient' 127 'Status = stsDefault') 128 ( 129 'Component = lstOrders' 130 'Status = stsDefault') 131 ( 132 'Component = frmRefillOrders' 133 'Status = stsDefault')) 134 end 109 135 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersRefill.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls ;7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOrdersRelease.dfm
r456 r829 2 2 Left = 318 3 3 Top = 186 4 Height = 3705 4 Caption = 'Release Orders to Service(s)' 5 ClientHeight = 343 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitLeft = 318 9 ExplicitTop = 186 10 ExplicitHeight = 377 8 11 PixelsPerInch = 96 9 12 TextHeight = 13 10 object Panel1: TPanel 13 object Panel1: TPanel [0] 11 14 Left = 0 12 15 Top = 0 … … 29 32 Align = alTop 30 33 Caption = 'The following orders will be released -' 34 ExplicitWidth = 176 31 35 end 32 36 object lstOrders: TCaptionListBox … … 45 49 end 46 50 end 47 object Panel2: TPanel 51 object Panel2: TPanel [1] 48 52 Left = 0 49 53 Top = 296 … … 51 55 Height = 47 52 56 Align = alBottom 53 BiDiMode = bdRightToLeft54 ParentBiDiMode = False55 57 TabOrder = 1 56 58 object grpRelease: TGroupBox … … 109 111 end 110 112 end 113 inherited amgrMain: TVA508AccessibilityManager 114 Data = ( 115 ( 116 'Component = Panel1' 117 'Status = stsDefault') 118 ( 119 'Component = lstOrders' 120 'Status = stsDefault') 121 ( 122 'Component = Panel2' 123 'Status = stsDefault') 124 ( 125 'Component = grpRelease' 126 'Status = stsDefault') 127 ( 128 'Component = radVerbal' 129 'Status = stsDefault') 130 ( 131 'Component = radPhone' 132 'Status = stsDefault') 133 ( 134 'Component = radPolicy' 135 'Status = stsDefault') 136 ( 137 'Component = cmdOK' 138 'Status = stsDefault') 139 ( 140 'Component = cmdCancel' 141 'Status = stsDefault') 142 ( 143 'Component = frmReleaseOrders' 144 'Status = stsDefault')) 145 end 111 146 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersRelease.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals; 7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals, 8 VA508AccessibilityManager; 8 9 9 10 type … … 42 43 43 44 uses Hash, rCore, rOrders, uConst, fSignItem, fOrdersPrint, uCore, uOrders, fRptBox, 44 fFrame, fClinicWardMeds ;45 fFrame, fClinicWardMeds, rODLab; 45 46 46 47 const … … 60 61 OrderText: string; 61 62 AnOrder: TOrder; 63 AList: TStringList; 62 64 63 65 function FindOrderText(const AnID: string): string; … … 131 133 begin 132 134 OrderText := FindOrderText(Piece(SignList[i], U, 1)); 133 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, TC_SAVERR, MB_OK); 135 if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then 136 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF + 137 'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.', 138 TC_SAVERR, MB_OK) 139 else 140 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, 141 TC_SAVERR, MB_OK); 134 142 end; 135 143 if Pos('R', Piece(SignList[i], U, 2)) > 0 then … … 137 145 end; 138 146 StatusText(''); 147 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders 148 AList := TStringList.Create; 149 try 150 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList); 151 if AList.Text <> '' then 152 ReportBox(AList, 'Changed Orders', TRUE); 153 finally 154 AList.Free; 155 end; 139 156 PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature, PrintLoc); 140 157 // SetupOrdersPrint(SignList, DeviceInfo, frmReleaseOrders.FNature, False, PrintIt); //*KCM* … … 244 261 ARect.Left := ARect.Left + 2; 245 262 Canvas.FillRect(ARect); 246 Canvas.Pen.Color := clSilver;263 Canvas.Pen.Color := Get508CompliantColor(clSilver); 247 264 SaveColor := Canvas.Brush.Color; 248 265 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); … … 271 288 x := FilteredString(Items[Index]); 272 289 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect); 273 //if AHeight > 255 then AHeight := 255;274 290 if AHeight < 13 then AHeight := 15; 275 291 end; -
cprs/trunk/CPRS-Chart/Orders/fOrdersRenew.dfm
r456 r829 5 5 HorzScrollBar.Visible = True 6 6 VertScrollBar.Tracking = True 7 AutoScroll = False8 7 Caption = 'Renew Orders' 9 8 ClientHeight = 416 … … 13 12 OnClose = FormClose 14 13 OnCreate = FormCreate 15 OnShow = FormShow 14 ExplicitWidth = 600 15 ExplicitHeight = 443 16 16 PixelsPerInch = 96 17 17 TextHeight = 13 18 object hdrOrders: THeaderControl 18 object hdrOrders: THeaderControl [0] 19 19 Left = 0 20 20 Top = 0 21 21 Width = 592 22 22 Height = 17 23 DragReorder = False24 23 Constraints.MinHeight = 17 25 24 Sections = < … … 38 37 OnSectionResize = hdrOrdersSectionResize 39 38 end 40 object pnlBottom: TPanel 39 object pnlBottom: TPanel [1] 41 40 Left = 0 42 41 Top = 393 … … 86 85 end 87 86 end 88 object lstOrders: TCaptionListBox 87 object lstOrders: TCaptionListBox [2] 89 88 Left = 0 90 89 Top = 17 … … 113 112 HintOnItem = True 114 113 end 114 inherited amgrMain: TVA508AccessibilityManager 115 Data = ( 116 ( 117 'Component = hdrOrders' 118 'Status = stsDefault') 119 ( 120 'Component = pnlBottom' 121 'Status = stsDefault') 122 ( 123 'Component = cmdCancel' 124 'Status = stsDefault') 125 ( 126 'Component = cmdOK' 127 'Status = stsDefault') 128 ( 129 'Component = cmdChange' 130 'Status = stsDefault') 131 ( 132 'Component = lstOrders' 133 'Status = stsDefault') 134 ( 135 'Component = frmRenewOrders' 136 'Status = stsDefault')) 137 end 115 138 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersRenew.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 fAutoSz, StdCtrls, ORFn, ComCtrls, uConst, rODMeds, uOrders, fOCAccept, 8 ExtCtrls, uODBase, ORCtrls ;8 ExtCtrls, uODBase, ORCtrls, VA508AccessibilityManager; 9 9 10 10 type … … 26 26 procedure cmdChangeClick(Sender: TObject); 27 27 procedure FormClose(Sender: TObject; var Action: TCloseAction); 28 procedure FormShow(Sender: TObject);29 28 procedure hdrOrdersSectionResize(HeaderControl: THeaderControl; 30 29 Section: THeaderSection); 30 procedure FormResize(Sender: TObject); 31 31 private 32 32 OKPressed: Boolean; … … 42 42 {$R *.DFM} 43 43 44 uses rOrders, fDateRange, fRenewOutMed, uCore, rCore, rMisc, UBAGlobals; 44 uses rOrders, fDateRange, fRenewOutMed, uCore, rCore, rMisc, UBAGlobals, 45 VA2006Utils; 45 46 46 47 const … … 103 104 try 104 105 frmRenewOrders.OrderList := SelectedList; 105 ResizeFormToFont(TForm(frmRenewOrders));106 106 IsInpt := OrderForInpatient; 107 107 … … 260 260 begin 261 261 inherited; 262 lstOrders.Color := ReadOnlyColor;262 FixHeaderControlDelphi2006Bug(hdrOrders); 263 263 OKPressed := False; 264 ResizeFormToFont(Self); 265 SetFormPosition(Self); 266 end; 267 268 procedure TfrmRenewOrders.FormResize(Sender: TObject); 269 var 270 i: integer; 271 Height: integer; 272 begin 273 inherited; 274 if lstorders.Count = 0 then exit; 275 for I := 0 to lstOrders.Count - 1 do 276 begin 277 Height := lstOrders.ItemRect(i).Bottom - lstOrders.ItemRect(i).Top; 278 lstOrdersMeasureItem(lstOrders,i,Height); 279 //ListGridDrawCell(lstOrders, hdrOrders, i, TEXT_COLUMN, x, WORD_WRAPPED); 280 end; 264 281 end; 265 282 … … 267 284 Index: Integer; var Height: Integer); 268 285 var 269 x : string;286 x, tmp: string; 270 287 DateHeight, TextHeight: Integer; 271 288 AnOrder: TOrder; … … 273 290 begin 274 291 inherited; 275 AnOrder := TOrder(OrderList.Items[Index]); 276 if AnOrder <> nil then 277 begin 278 RenewFields := TOrderRenewFields(AnOrder.LinkObject); 279 with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime; 280 TextHeight := MeasureColumnHeight(RenewFields.NewText,Index,TEXT_COLUMN); 281 DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN); 282 Height := HigherOf(TextHeight, DateHeight); 283 if Height > 255 then Height := 255; //This is maximum allowed by a windows listbox item. 284 end 292 AnOrder := TOrder(OrderList.Items[Index]); 293 if (AnOrder <> nil) then 294 begin 295 RenewFields := TOrderRenewFields(AnOrder.LinkObject); 296 with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime; 297 //tmp := RenewFields.NewText; 298 tmp := LstOrders.Items.Strings[index]; 299 TextHeight := MeasureColumnHeight(tmp,Index,TEXT_COLUMN); 300 DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN); 301 Height := HigherOf(TextHeight, DateHeight); 302 if Height > 255 then Height := 255; //This is maximum allowed by a windows listbox item. 303 end 285 304 end; 286 305 … … 420 439 end; 421 440 422 procedure TfrmRenewOrders.FormShow(Sender: TObject);423 begin424 inherited;425 SetFormPosition(Self);426 end;427 428 441 procedure TfrmRenewOrders.hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); 429 442 begin -
cprs/trunk/CPRS-Chart/Orders/fOrdersSign.dfm
r456 r829 1 object frmSignOrders: TfrmSignOrders 2 Left = 400 3 Top = 159 4 Width = 585 5 Height = 511 1 inherited frmSignOrders: TfrmSignOrders 2 Left = 337 3 Top = 142 6 4 Caption = 'Sign Orders' 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 = 487 6 ClientWidth = 833 14 7 OldCreateOrder = True 15 8 Position = poScreenCenter 16 9 OnCreate = FormCreate 17 10 OnDestroy = FormDestroy 18 OnKeyDown = FormKeyDown19 11 OnMouseDown = clstOrdersMouseDown 20 12 OnMouseMove = FormMouseMove 13 OnResize = FormResize 21 14 OnShow = FormShow 15 ExplicitWidth = 841 16 ExplicitHeight = 514 22 17 DesignSize = ( 23 57724 48 4)18 833 19 487) 25 20 PixelsPerInch = 96 26 21 TextHeight = 13 27 object lblESCode: TLabel 22 object lblESCode: TLabel [0] 28 23 Left = 8 29 Top = 44 124 Top = 449 30 25 Width = 123 31 26 Height = 13 32 27 Anchors = [akLeft, akBottom] 33 28 Caption = 'Electronic Signature Code' 34 end 35 object laDiagnosis: TLabel 29 ExplicitTop = 446 30 end 31 object laDiagnosis: TLabel [1] 36 32 Left = 184 37 33 Top = 185 … … 41 37 Visible = False 42 38 end 43 object Label2: TStaticText39 object lblOrderList: TStaticText [2] 44 40 Left = 8 45 Top = 1 4746 Width = 17141 Top = 163 42 Width = 205 47 43 Height = 17 48 Caption = ' The following orders will be signed -'44 Caption = 'Signature will be Applied to Checked Items' 49 45 TabOrder = 3 50 46 TabStop = True 51 47 end 52 object cmdOK: TButton 53 Left = 41754 Top = 45 548 object cmdOK: TButton [3] 49 Left = 673 50 Top = 458 55 51 Width = 72 56 52 Height = 21 … … 61 57 OnClick = cmdOKClick 62 58 end 63 object cmdCancel: TButton 64 Left = 49765 Top = 45 559 object cmdCancel: TButton [4] 60 Left = 753 61 Top = 458 66 62 Width = 72 67 63 Height = 21 … … 72 68 OnClick = cmdCancelClick 73 69 end 74 object txtESCode: TCaptionEdit 70 object txtESCode: TCaptionEdit [5] 75 71 Left = 8 76 Top = 4 5572 Top = 463 77 73 Width = 137 78 74 Height = 21 … … 82 78 Caption = 'Electronic Signature Code' 83 79 end 84 inline fraCoPay: TfraCoPayDesc 85 Left = 0 86 Top = 0 87 Width = 577 88 Height = 132 89 Align = alTop 90 ParentShowHint = False 91 ShowHint = True 92 TabOrder = 5 93 Visible = False 94 inherited pnlRight: TPanel 95 Left = 328 96 inherited lblCaption: TStaticText 97 Caption = 'Patient Orders Related To:' 98 end 99 inherited pnlMain: TPanel 100 inherited Panel7: TPanel 101 inherited lblHNC2: TORStaticText 102 OnEnter = fraCoPayLabel23Enter 103 OnExit = fraCoPayLabel23Exit 104 end 105 inherited lblHNC: TORStaticText 106 OnEnter = fraCoPayLabel23Enter 107 OnExit = fraCoPayLabel23Exit 108 end 109 end 110 inherited Panel8: TPanel 111 inherited Label12: TORStaticText 112 OnEnter = fraCoPayLabel23Enter 113 OnExit = fraCoPayLabel23Exit 114 end 115 inherited Label11: TORStaticText 116 OnEnter = fraCoPayLabel23Enter 117 OnExit = fraCoPayLabel23Exit 118 end 119 end 120 inherited Panel9: TPanel 121 inherited Label14: TORStaticText 122 OnEnter = fraCoPayLabel23Enter 123 OnExit = fraCoPayLabel23Exit 124 end 125 inherited Label13: TORStaticText 126 OnEnter = fraCoPayLabel23Enter 127 OnExit = fraCoPayLabel23Exit 128 end 129 end 130 inherited Panel10: TPanel 131 inherited Label16: TORStaticText 132 OnEnter = fraCoPayLabel23Enter 133 OnExit = fraCoPayLabel23Exit 134 end 135 inherited Label15: TORStaticText 136 OnEnter = fraCoPayLabel23Enter 137 OnExit = fraCoPayLabel23Exit 138 end 139 end 140 inherited Panel11: TPanel 141 inherited Label18: TORStaticText 142 OnEnter = fraCoPayLabel23Enter 143 OnExit = fraCoPayLabel23Exit 144 end 145 inherited Label17: TORStaticText 146 OnEnter = fraCoPayLabel23Enter 147 OnExit = fraCoPayLabel23Exit 148 end 149 end 150 inherited Panel12: TPanel 151 inherited Label24: TORStaticText 152 OnEnter = fraCoPayLabel23Enter 153 OnExit = fraCoPayLabel23Exit 154 end 155 inherited Label23: TORStaticText 156 OnEnter = fraCoPayLabel23Enter 157 OnExit = fraCoPayLabel23Exit 158 end 159 end 160 inherited Panel1: TPanel 161 inherited StaticText4: TORStaticText 162 OnEnter = fraCoPayLabel23Enter 163 OnExit = fraCoPayLabel23Exit 164 end 165 inherited StaticText1: TORStaticText 166 OnEnter = fraCoPayLabel23Enter 167 OnExit = fraCoPayLabel23Exit 168 end 169 end 170 end 171 end 172 inherited pnlSC: TPanel 173 Width = 328 174 inherited lblSCDisplay: TLabel 175 Width = 328 176 end 177 inherited memSCDisplay: TCaptionMemo 178 Width = 328 179 end 180 end 181 end 182 object clstOrders: TCaptionCheckListBox 80 object clstOrders: TCaptionCheckListBox [6] 183 81 Left = 8 184 Top = 1 62185 Width = 564186 Height = 2 7782 Top = 181 83 Width = 820 84 Height = 262 187 85 OnClickCheck = clstOrdersClickCheck 188 86 Anchors = [akLeft, akTop, akRight, akBottom] … … 201 99 Caption = 'The following orders will be signed -' 202 100 end 203 object gbdxLookup: TGroupBox 101 object gbdxLookup: TGroupBox [7] 204 102 Left = 7 205 Top = 1 39103 Top = 157 206 104 Width = 99 207 105 Height = 43 208 106 Caption = 'Lookup Diagnosis' 209 107 Font.Charset = DEFAULT_CHARSET 210 Font.Color = cl Black108 Font.Color = clWindowText 211 109 Font.Height = -11 212 110 Font.Name = 'MS Sans Serif' … … 227 125 end 228 126 end 127 inline fraCoPay: TfraCoPayDesc [8] 128 Left = 0 129 Top = 0 130 Width = 833 131 Height = 157 132 Align = alTop 133 AutoSize = True 134 ParentShowHint = False 135 ShowHint = True 136 TabOrder = 5 137 TabStop = True 138 Visible = False 139 ExplicitWidth = 833 140 inherited pnlRight: TPanel 141 Left = 545 142 ExplicitLeft = 545 143 inherited pnlMain: TPanel 144 inherited pnlHNC: TPanel 145 inherited lblHNC2: TVA508StaticText 146 Width = 129 147 ExplicitWidth = 129 148 end 149 inherited lblHNC: TVA508StaticText 150 Width = 31 151 ExplicitWidth = 31 152 end 153 end 154 inherited pnlMST: TPanel 155 inherited lblMST2: TVA508StaticText 156 Width = 25 157 ExplicitWidth = 25 158 end 159 inherited lblMST: TVA508StaticText 160 Width = 31 161 ExplicitWidth = 31 162 end 163 end 164 inherited pnlSWAC: TPanel 165 inherited lblSWAC2: TVA508StaticText 166 Width = 127 167 ExplicitWidth = 127 168 end 169 inherited lblSWAC: TVA508StaticText 170 Width = 40 171 ExplicitWidth = 40 172 end 173 end 174 inherited pnlIR: TPanel 175 inherited lblIR2: TVA508StaticText 176 Width = 133 177 ExplicitWidth = 133 178 end 179 inherited lblIR: TVA508StaticText 180 Width = 19 181 ExplicitWidth = 19 182 end 183 end 184 inherited pnlAO: TPanel 185 inherited lblAO2: TVA508StaticText 186 Width = 115 187 ExplicitWidth = 115 188 end 189 inherited lblAO: TVA508StaticText 190 Width = 23 191 ExplicitWidth = 23 192 end 193 end 194 inherited pnlCV: TPanel 195 inherited lblCV2: TVA508StaticText 196 Width = 142 197 ExplicitWidth = 142 198 end 199 end 200 inherited pnlSHD: TPanel 201 inherited lblSHAD: TVA508StaticText 202 Width = 33 203 ExplicitWidth = 33 204 end 205 inherited lblSHAD2: TVA508StaticText 206 Width = 159 207 ExplicitWidth = 159 208 end 209 end 210 end 211 end 212 inherited pnlSCandRD: TPanel 213 Width = 545 214 ExplicitWidth = 545 215 inherited lblSCDisplay: TLabel 216 Width = 545 217 ExplicitWidth = 311 218 end 219 inherited memSCDisplay: TCaptionMemo 220 Width = 545 221 ExplicitWidth = 545 222 end 223 end 224 end 225 inherited amgrMain: TVA508AccessibilityManager 226 Data = ( 227 ( 228 'Component = lblOrderList' 229 'Status = stsDefault') 230 ( 231 'Component = cmdOK' 232 'Status = stsDefault') 233 ( 234 'Component = cmdCancel' 235 'Status = stsDefault') 236 ( 237 'Component = txtESCode' 238 'Status = stsDefault') 239 ( 240 'Component = clstOrders' 241 'Status = stsDefault') 242 ( 243 'Component = gbdxLookup' 244 'Status = stsDefault') 245 ( 246 'Component = buOrdersDiagnosis' 247 'Status = stsDefault') 248 ( 249 'Component = fraCoPay' 250 'Status = stsDefault') 251 ( 252 'Component = fraCoPay.pnlRight' 253 'Status = stsDefault') 254 ( 255 'Component = fraCoPay.lblCaption' 256 'Status = stsDefault') 257 ( 258 'Component = fraCoPay.pnlMain' 259 'Status = stsDefault') 260 ( 261 'Component = fraCoPay.pnlHNC' 262 'Status = stsDefault') 263 ( 264 'Component = fraCoPay.lblHNC2' 265 'Status = stsDefault') 266 ( 267 'Component = fraCoPay.lblHNC' 268 'Status = stsDefault') 269 ( 270 'Component = fraCoPay.pnlMST' 271 'Status = stsDefault') 272 ( 273 'Component = fraCoPay.lblMST2' 274 'Status = stsDefault') 275 ( 276 'Component = fraCoPay.lblMST' 277 'Status = stsDefault') 278 ( 279 'Component = fraCoPay.pnlSWAC' 280 'Status = stsDefault') 281 ( 282 'Component = fraCoPay.lblSWAC2' 283 'Status = stsDefault') 284 ( 285 'Component = fraCoPay.lblSWAC' 286 'Status = stsDefault') 287 ( 288 'Component = fraCoPay.pnlIR' 289 'Status = stsDefault') 290 ( 291 'Component = fraCoPay.lblIR2' 292 'Status = stsDefault') 293 ( 294 'Component = fraCoPay.lblIR' 295 'Status = stsDefault') 296 ( 297 'Component = fraCoPay.pnlAO' 298 'Status = stsDefault') 299 ( 300 'Component = fraCoPay.lblAO2' 301 'Status = stsDefault') 302 ( 303 'Component = fraCoPay.lblAO' 304 'Status = stsDefault') 305 ( 306 'Component = fraCoPay.pnlSC' 307 'Status = stsDefault') 308 ( 309 'Component = fraCoPay.lblSC2' 310 'Status = stsDefault') 311 ( 312 'Component = fraCoPay.lblSC' 313 'Status = stsDefault') 314 ( 315 'Component = fraCoPay.pnlCV' 316 'Status = stsDefault') 317 ( 318 'Component = fraCoPay.lblCV2' 319 'Status = stsDefault') 320 ( 321 'Component = fraCoPay.lblCV' 322 'Status = stsDefault') 323 ( 324 'Component = fraCoPay.pnlSHD' 325 'Status = stsDefault') 326 ( 327 'Component = fraCoPay.lblSHAD' 328 'Status = stsDefault') 329 ( 330 'Component = fraCoPay.lblSHAD2' 331 'Status = stsDefault') 332 ( 333 'Component = fraCoPay.pnlSCandRD' 334 'Status = stsDefault') 335 ( 336 'Component = fraCoPay.memSCDisplay' 337 'Status = stsDefault') 338 ( 339 'Component = frmSignOrders' 340 'Status = stsDefault')) 341 end 229 342 object poBACopyPaste: TPopupMenu 230 343 Left = 344 -
cprs/trunk/CPRS-Chart/Orders/fOrdersSign.pas
r456 r829 9 9 fAutoSz, StdCtrls, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB, 10 10 ComCtrls, CheckLst, ExtCtrls, uConsults, UBAGlobals,UBACore, UBAMessages, UBAConst, 11 Menus, ORClasses ;11 Menus, ORClasses, fBase508Form, fPrintLocation, VA508AccessibilityManager; 12 12 13 13 type 14 TfrmSignOrders = class(T Form)14 TfrmSignOrders = class(TfrmBase508Form) 15 15 cmdOK: TButton; 16 16 cmdCancel: TButton; 17 17 lblESCode: TLabel; 18 18 txtESCode: TCaptionEdit; 19 fraCoPay: TfraCoPayDesc;20 19 clstOrders: TCaptionCheckListBox; 21 20 laDiagnosis: TLabel; … … 27 26 Diagnosis1: TMenuItem; 28 27 Exit1: TMenuItem; 29 Label2: TStaticText; 28 lblOrderList: TStaticText; 29 fraCoPay: TfraCoPayDesc; 30 30 procedure FormCreate(Sender: TObject); 31 31 procedure cmdOKClick(Sender: TObject); … … 54 54 procedure clstOrdersKeyUp(Sender: TObject; var Key: Word; 55 55 Shift: TShiftState); 56 procedure FormResize(Sender: TObject); 56 57 private 57 58 OKPressed: Boolean; … … 62 63 function ItemsAreChecked: Boolean; 63 64 function GetNumberOfSelectedOrders : byte; 64 procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: T ORStaticText); // 50865 procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508 65 66 procedure SetItemTextToState; 66 67 procedure FormatListForScreenReader; … … 72 73 73 74 {Begin BillingAware} 74 { TODO 3 -oKW -cRefinement : Change to dynamic array or other dynamic structure for Billing Awareness Phase II. } 75 TarRect = array[MIN_RECT..MAX_RECT] of TRect; 75 TarRect = array[MIN_RECT..MAX_RECT] of TRect; 76 76 77 77 var … … 105 105 srcIndex: integer; 106 106 CopyBuffer: TBADxRecord; 107 //CopyActive: boolean; //CQ6225108 107 {End BillingAware} 109 108 … … 114 113 uses 115 114 Hash, rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, uSignItems, fOrders, 116 fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame; 115 fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame, rODLab, fRptBox, 116 VAUtils; 117 117 118 118 const … … 141 141 on EListError do 142 142 begin 143 {$ifdef debug}Show Message('EListError in frmSignOrders.GetNumberOfSelectedOrders()');{$endif}143 {$ifdef debug}Show508Message('EListError in frmSignOrders.GetNumberOfSelectedOrders()');{$endif} 144 144 raise; 145 145 end; … … 174 174 itemsList.Clear; 175 175 itemsList := uSigItems.GetSigItems; //Get FItems list 176 177 176 if BILLING_AWARE then 178 177 begin … … 190 189 on EListError do 191 190 begin 192 {$ifdef debug}Show Message('EListError in frmSignOrders.GetCheckBoxStatus()');{$endif}191 {$ifdef debug}Show508Message('EListError in frmSignOrders.GetCheckBoxStatus()');{$endif} 193 192 raise; 194 193 end; … … 198 197 199 198 function ExecuteSignOrders(SelectedList: TList): Boolean; 200 var 201 i, cidx,cnt, theSts: Integer; 199 const 200 VERT_SPACING = 6; 201 202 var 203 i, cidx,cnt, theSts, WardIEN: Integer; 202 204 ShrinkHeight: integer; 203 205 SignList: TStringList; 204 206 Obj: TOrder; 205 DigSigErr, DigStoreErr : Boolean;207 DigSigErr, DigStoreErr, ContainsIMOOrders, DoNotPrint: Boolean; 206 208 x, SigData, SigUser, SigDrugSch, SigDEA: string; 207 cSignature, cHashData, cCrlUrl, cErr : string;209 cSignature, cHashData, cCrlUrl, cErr, WardName: string; 208 210 cProvDUZ: Int64; 209 OrderText : string;211 OrderText, ASvc: string; 210 212 PrintLoc: Integer; 211 // tempOrderID: string; 213 AList, ClinicList, DCList, OrderPrintList, WardList: TStringList; 214 EncLocName, EncLocText: string; 215 EncLocIEN: integer; 216 EncDT: TFMDateTime; 217 EncVC: Char; 212 218 213 219 function FindOrderText(const AnID: string): string; … … 253 259 DigSigErr := True; 254 260 PrintLoc := 0; 261 EncLocIEN := 0; 262 DoNotPrint := False; 255 263 if SelectedList.Count = 0 then Exit; 256 264 if BILLING_AWARE then … … 268 276 cidx := frmSignOrders.clstOrders.Items.AddObject(Obj.Text,Obj); 269 277 SigItems.Add(CH_ORD,Obj.ID, cidx); 270 //HDS6205 allows dx entry for NON CIDC Consult orders 271 // if BILLING_AWARE then //HDS6205 272 // if UBAGlobals.BAConsultOrdersRequireDx.Count > 0 then //HDS6205 273 // begin 274 // tempOrderID := UBACore.SetOrderIDConsultDxRequired(Piece(Obj.ID,';',1) + ';1'); //HDS6205 275 // tempOrderList.Add(tempOrderID); //HDS6205 276 // end 277 // else 278 if BILLING_AWARE then 279 tempOrderList.Add(Obj.ID); 280 278 if BILLING_AWARE then 279 tempOrderList.Add(Obj.ID); 281 280 frmSignOrders.clstOrders.Checked[cidx] := TRUE; 282 281 … … 295 294 {End BillingAware} 296 295 297 ShrinkHeight := frmSignOrders.fraCoPay.Height + 9; 298 frmSignOrders.Height := frmSignOrders.Height - ShrinkHeight; 299 frmSignOrders.Label2.Top := frmSignOrders.Label2.Top - ShrinkHeight; 300 frmSignOrders.clstOrders.Top := frmSignOrders.clstOrders.Top - ShrinkHeight; 301 frmSignOrders.clstOrders.Height := frmSignOrders.clstOrders.Height + ShrinkHeight; 296 with frmSignOrders do begin 297 ShrinkHeight := lblOrderList.Top - VERT_SPACING; 298 Height := Height - ShrinkHeight; 299 lblOrderList.Top := lblOrderList.Top - ShrinkHeight; 300 clstOrders.Top := clstOrders.Top - ShrinkHeight; 301 clstOrders.Height := clstOrders.Height + ShrinkHeight; 302 end; 302 303 end; 303 304 … … 329 330 end; 330 331 331 frmSignOrders.ShowModal;332 frmSignOrders.ShowModal; 332 333 if frmSignOrders.OKPressed then 333 334 begin 334 335 Result := True; 335 336 SignList := TStringList.Create; 337 ClinicList := TStringList.Create; 338 OrderPrintList := TStringList.Create; 339 WardList := TStringList.Create; 340 ContainsIMOOrders := false; 336 341 try 337 342 with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do … … 346 351 if Length(SigData) < 1 then 347 352 begin 348 ShowM essage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');353 ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server'); 349 354 DigStoreErr := true; 350 355 end; … … 368 373 else 369 374 begin 370 ShowM essage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));375 ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2)); 371 376 DigStoreErr := true; 372 377 end; … … 374 379 on E: Exception do 375 380 begin 376 ShowM essage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);381 ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message); 377 382 DigStoreErr := true; 378 383 end; … … 399 404 if GetPKISite and (Copy(TOrder(SelectedList.Items[i]).DigSigReq,1,1) = '2') then 400 405 begin 401 ShowM essage('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + TOrder(SelectedList.Items[i]).Text + CRLF + CRLF +406 ShowMsg('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 402 407 'This Schedule II medication cannot be electronically entered without a Digital Signature. ' + 403 408 CRLF + 'Please discontinue/cancel this order and create a hand written order for manual processing, or digitally sign the order at a PKI-enabled workstation.'); … … 418 423 if SignList.Count > 0 then 419 424 begin 420 421 //hds7591 Clinic/Ward movement. Patient Admission IMO 422 if not frmFrame.TimedOut then 423 begin 424 if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then 425 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,uCore.Encounter.LocationName, PrintLoc) 426 else 427 if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then 428 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc); 429 end; 430 uCore.TempEncounterLoc := 0; 431 uCore.TempEncounterLocName := ''; 432 //hds7591 Clinic/Ward movement Patient Admission IMO 425 //hds7591 Clinic/Ward movement. Patient Admission IMO 426 if not frmFrame.TimedOut then 427 begin 428 if (Patient.Inpatient = True) and (Encounter.Location <> Patient.Location) then 429 begin 430 DCList := TStringList.Create; 431 EncLocName := Encounter.LocationName; 432 EncLocIEN := Encounter.Location; 433 EncLocText := Encounter.LocationText; 434 EncDT := Encounter.DateTime; 435 EncVC := Encounter.VisitCategory; 436 for i := 0 to SelectedList.Count - 1 do 437 begin 438 cidx := frmSignOrders.clstOrders.Items.IndexOfObject(TOrder(SelectedList.Items[i])); 439 if frmSignOrders.clstOrders.Checked[cidx] = false then continue; 440 if TOrder(SelectedList.Items[i]).DGroupName = 'Clinic Orders' then ContainsIMOOrders := true; 441 if TOrder(SelectedList.Items[i]).DGroupName = '' then continue; 442 if TOrder(SelectedList.Items[i]).EventPtr <> '' then continue; 443 if Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0 then 444 begin 445 DCList.Add(TOrder(SelectedList.Items[i]).ID); 446 Continue; 447 end; 448 OrderPrintList.Add(TOrder(SelectedList.Items[i]).ID + ':' + TOrder(SelectedList.Items[i]).Text); 449 end; 450 if OrderPrintList.Count > 0 then 451 begin 452 frmPrintLocation.PrintLocation(OrderPrintList, EncLocIEN, EncLocName, EncLocText, EncDT, EncVC, ClinicList, 453 WardList, WardIen,WardName, ContainsIMOOrders, true); 454 fframe.frmFrame.OrderPrintForm := false; 455 end 456 else DoNotPrint := True; 457 if (DCList <> nil) and (DCList.Count > 0) then 458 begin 459 for i := 0 to DCList.Count - 1 do 460 WardList.Add(DCList.Strings[i]); 461 if (WardIEN = 0) and (WardName = '') then 462 CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc); 463 end; 464 if DCList <> nil then DCList.Free; 465 end; 466 end; 467 uCore.TempEncounterLoc := 0; 468 uCore.TempEncounterLocName := ''; 469 //hds7591 Clinic/Ward movement Patient Admission IMO 433 470 434 471 SigItems.SaveSettings; // Save CoPay FIRST! 435 472 SendOrders(SignList, frmSignOrders.ESCode); 436 437 end; 473 end; 438 474 439 475 with SignList do if Count > 0 then for i := 0 to Count - 1 do … … 442 478 begin 443 479 OrderText := FindOrderText(Piece(SignList[i], U, 1)); 480 if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then 481 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF + 482 'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.', 483 TC_SAVERR, MB_OK) 484 else 444 485 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, 445 486 TC_SAVERR, MB_OK); 446 487 end; 447 488 if Pos('R', Piece(SignList[i], U, 2)) > 0 then … … 459 500 if theSts = 10 then SignList.Delete(cnt); //signed delayed order should not be printed. 460 501 end; 461 PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc); 502 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders 503 AList := TStringList.Create; 504 try 505 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList); 506 if AList.Text <> '' then 507 ReportBox(AList, 'Changed Orders', TRUE); 508 finally 509 AList.Free; 510 end; 511 if(ClinicList.Count > 0) or (WardList.count > 0) then 512 PrintOrdersOnSignReleaseMult(SignList, CLinicList, WardList, NO_PROVIDER, EncLocIEN, WardIEN, EncLocName, wardName) 513 else if DoNotPrint = False then PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc); 462 514 finally 463 515 SignList.Free; 516 OrderPrintList.free; 517 WardList.free; 518 ClinicList.free; 464 519 end; 465 520 end; {if frmSignOrders.OKPressed} … … 486 541 if BILLING_AWARE then 487 542 begin 488 clstOrders.Height := 2 34;543 clstOrders.Height := 228; 489 544 clstOrders.Top := (gbdxLookup.top + 65); 490 545 gbDxLookup.Visible := TRUE; 491 l abel2.Top := (gbdxLookup.Top + 48);492 laDiagnosis.Top := Label2.Top;546 lblOrderList.Top := (gbdxLookup.Top + gbdxLookup.Height); 547 laDiagnosis.Top := lblOrderList.Top; 493 548 laDiagnosis.Left := 270; 494 549 laDiagnosis.Visible := TRUE; … … 497 552 else 498 553 begin 499 l abel2.Top := 145;500 l abel2.Left := 8;554 lblOrderList.Top := 158; 555 lblOrderList.Left := 8; 501 556 end; 502 557 {End BillingAware} … … 609 664 begin 610 665 Canvas.FillRect(ARect); 611 Canvas.Pen.Color := clSilver;666 Canvas.Pen.Color := Get508CompliantColor(clSilver); 612 667 Canvas.MoveTo(ARect.Left, ARect.Bottom); 613 668 Canvas.LineTo(ARect.Right, ARect.Bottom); … … 619 674 //Adjust position of 'Diagnosis' column label for font size 620 675 laDiagnosis.Left := ARect.Right + 14; 621 622 //ARect.Right below controls the right-hand side of the Dx Column 623 //Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the 624 //two rectangles overlap each other. 676 if uSignItems.GetAllBtnLeftPos > 0 then 677 laDiagnosis.left := uSignItems.GetAllBtnLeftPos - (laDiagnosis.Width +5); 678 // ARect.Right below controls the right-hand side of the Dx Column 679 // Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the 680 // two rectangles overlap each other. 625 681 if BILLING_AWARE then 626 682 begin … … 631 687 //Win32 API - This call to DrawText draws the text of the ORDER - not the diagnosis code 632 688 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK); 633 {v25 BA} 634 if BILLING_AWARE then 689 if BILLING_AWARE then 635 690 begin 636 691 if Assigned(UBAGlobals.tempDxList) then 637 692 begin 638 tempID := TOrder(clstOrders.Items.Objects[Index]).ID;693 tempID := TOrder(clstOrders.Items.Objects[Index]).ID; 639 694 640 695 if UBAGlobals.tempDxNodeExists(tempID) then … … 646 701 str := Piece(str,':',1); 647 702 DrawText(Canvas.handle, PChar(str), Length(str), arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK); 648 if Not UBACore.IsOrderBillable(tempID) then //and 649 // Not UBAGlobals.tempDxNodeExists(tempID) then // if consult is non cidc but requires dx, show it. 703 if Not UBACore.IsOrderBillable(tempID) then 650 704 begin 651 705 Canvas.Font.Color := clBlue; … … 676 730 if Index < Items.Count then 677 731 begin 678 Canvas.FillRect(ARect);679 Canvas.Pen.Color := clSilver;680 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);681 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);682 X := FilteredString(Items[Index]);683 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);732 Canvas.FillRect(ARect); 733 Canvas.Pen.Color := Get508CompliantColor(clSilver); 734 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); 735 Canvas.LineTo(ARect.Right, ARect.Bottom - 1); 736 X := FilteredString(Items[Index]); 737 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK); 684 738 end; 685 739 end; … … 761 815 if Checked[i] then 762 816 begin 763 Result := True;764 break;817 Result := True; 818 break; 765 819 end; 766 820 end; … … 795 849 for i := 0 to (tempDxList.Count - 1) do 796 850 begin 797 thisRec := TBADxRecord(tempDxList.Items[i]);851 thisRec := TBADxRecord(tempDxList.Items[i]); 798 852 799 853 if Assigned(thisRec) then … … 815 869 on EListError do 816 870 begin 817 {$ifdef debug}Show Message('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif}871 {$ifdef debug}Show508Message('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif} 818 872 raise; 819 873 end; … … 841 895 {Begin BillingAware} 842 896 897 if (clstOrders.Top + clstOrders.Height) > (lblESCode.Top - 4) then 898 clstOrders.Height := lblESCode.Top - clstOrders.Top - 4; 899 843 900 //INITIALIZATIONS 844 901 Paste1.Enabled := false; … … 859 916 with fraCoPay do 860 917 begin 861 Label24.Caption := 'Service &Connected Condition';862 StaticText4.Caption := 'Combat &Vet (Combat Related)';863 Label18.Caption := 'Agent &Orange Exposure';864 Label16.Caption := 'Ionizing &Radiation Exposure';865 Label14.Caption := '&Environmental Contaminants';866 Label12.Caption := '&MST';918 lblSC2.Caption := 'Service &Connected Condition'; 919 lblCV2.Caption := 'Combat &Vet (Combat Related)'; 920 lblAO2.Caption := 'Agent &Orange Exposure'; 921 lblIR2.Caption := 'Ionizing &Radiation Exposure'; 922 lblSWAC2.Caption := '&Environmental Contaminants'; 923 lblMST2.Caption := '&MST'; 867 924 lblHNC2.Caption := '&Head and/or Neck Cancer'; 868 Label24.ShowAccelChar := true; 869 StaticText4.ShowAccelChar := true; 870 Label18.ShowAccelChar := true; 871 Label16.ShowAccelChar := true; 872 Label14.ShowAccelChar := true; 873 Label12.ShowAccelChar := true; 925 lblSHAD2.Caption := 'Shi&pboard Hazard and Defense'; 926 lblSC2.ShowAccelChar := true; 927 lblCV2.ShowAccelChar := true; 928 lblAO2.ShowAccelChar := true; 929 lblIR2.ShowAccelChar := true; 930 lblSWAC2.ShowAccelChar := true; 931 lblMST2.ShowAccelChar := true; 874 932 lblHNC2.ShowAccelChar := true; 933 lblSHAD2.ShowAccelChar := true; 875 934 end; 876 935 end; //BILLING_AWARE … … 916 975 match := false; 917 976 allBlank := false; 918 //orderIDList := TStringList.Create;919 977 if Assigned (orderIDList) then orderIDList.Clear; 920 978 if Assigned(UBAGlobals.PLFactorsIndexes) then UBAGlobals.PLFactorsIndexes.Clear; … … 952 1010 {$ifdef debug} 953 1011 with UBAGlobals.globalDxRec do 954 //Show Message('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3);1012 //Show508Message('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3); 955 1013 {$endif} 956 1014 end; … … 959 1017 except 960 1018 on E: Exception do 961 ShowM essage(E.ClassName+' error raised, with message : '+E.Message);1019 ShowMsg(E.ClassName+' error raised, with message : '+E.Message); 962 1020 end; 963 1021 … … 966 1024 if numSelected = 0 then 967 1025 begin 968 ShowM essage(UBAMessages.BA_NO_ORDERS_SELECTED);1026 ShowMsg(UBAMessages.BA_NO_ORDERS_SELECTED); 969 1027 Exit; 970 1028 end … … 981 1039 982 1040 if ((match and allBlank) or (match and (not allBlank))) then // All selected are blank or matching-not-blank 983 // begin 984 { TODO 3 -oKW -cRefinement : Define a const to replace string literal } 985 frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList) 1041 frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList) 986 1042 else 987 1043 begin … … 992 1048 Exit 993 1049 else 994 // begin995 1050 if Assigned(UBAGlobals.globalDxRec) then 996 1051 InitializeNewDxRec(UBAGlobals.globalDxRec); … … 1030 1085 if numSelected > 1 then 1031 1086 begin 1032 ShowM essage('Only 1 order at a time may be selected for ''Copying''');1087 ShowMsg('Only 1 order at a time may be selected for ''Copying'''); 1033 1088 Exit; 1034 1089 end; … … 1058 1113 //************************************************************************* 1059 1114 if (NOT UBACore.IsOrderBillable(fOrdersSign.srcOrderID) ) then //and 1060 // (NOT tempDxNodeExists(fOrdersSign.srcOrderID)) then// added to allow copy to NON CIDC consult order the requires a DX. then1115 // added to allow copy to NON CIDC consult order the requires a DX. then 1061 1116 begin 1062 ShowMessage(BA_NA_COPY_DISALLOWED);1063 fOrdersSign.srcOrderID := '';1064 Exit;1117 ShowMsg(BA_NA_COPY_DISALLOWED); 1118 fOrdersSign.srcOrderID := ''; 1119 Exit; 1065 1120 end; 1066 1121 //************************************************************************* … … 1074 1129 on EListError do 1075 1130 begin 1076 ShowMessage('EListError in frmSignOrders.Copy1Click()');1131 ShowMsg('EListError in frmSignOrders.Copy1Click()'); 1077 1132 raise; 1078 1133 end; 1079 1134 end; 1080 1081 //CopyActive := true; //CQ62251082 //Paste1.Enabled := true; //CQ62251083 1135 end; 1084 1136 … … 1101 1153 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then 1102 1154 begin 1103 fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;1155 fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID; 1104 1156 1105 1157 if fOrdersSign.targetOrderID = fOrdersSign.srcOrderID then //disallow copying an order to itself … … 1112 1164 if Not UBACore.IsOrderBillable(targetOrderID) then 1113 1165 begin 1114 ShowMessage(BA_NA_PASTE_DISALLOWED);1115 fOrdersSign.targetOrderID := '';1116 Continue;1166 ShowMsg(BA_NA_PASTE_DISALLOWED); 1167 fOrdersSign.targetOrderID := ''; 1168 Continue; 1117 1169 end; 1118 1170 //*************************************************************** … … 1121 1173 with newRec do 1122 1174 begin 1123 FOrderID := fOrdersSign.targetOrderID;1124 FBADxCode := CopyBuffer.FBADxCode;1125 FBASecDx1 := CopyBuffer.FBASecDx1;1126 FBASecDx2 := CopyBuffer.FBASecDx2;1127 FBASecDx3 := CopyBuffer.FBASecDx3;1175 FOrderID := fOrdersSign.targetOrderID; 1176 FBADxCode := CopyBuffer.FBADxCode; 1177 FBASecDx1 := CopyBuffer.FBASecDx1; 1178 FBASecDx2 := CopyBuffer.FBASecDx2; 1179 FBASecDx3 := CopyBuffer.FBASecDx3; 1128 1180 end; 1129 1181 … … 1138 1190 on EListError do 1139 1191 begin 1140 ShowMessage('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do');1192 ShowMsg('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do'); 1141 1193 raise; 1142 1194 end; … … 1144 1196 clstOrders.Refresh; //Update grid to show pasted Dx 1145 1197 end; 1146 {1147 //CQ62251148 if CopyActive then1149 begin1150 Paste1.Enabled := false;1151 CopyActive := false;1152 end;1153 //end CQ62251154 }1155 1198 end; 1156 1199 … … 1173 1216 if fOrdersSign.frmSignOrders.clstOrders.Items.Count = 1 then 1174 1217 begin 1175 Copy1.Enabled := false;1176 Paste1.Enabled := false1218 Copy1.Enabled := false; 1219 Paste1.Enabled := false 1177 1220 end 1178 1221 else 1179 1222 begin 1180 Copy1.Enabled := true; 1181 //Paste1.Enabled := true; //commented out for CQ6225 1223 Copy1.Enabled := true; 1182 1224 end; 1183 1225 //End CQ3325 … … 1194 1236 on EListError do 1195 1237 begin 1196 ShowMessage('EListError in frmSignOrders.clstOrdersMouseDown()');1238 ShowMsg('EListError in frmSignOrders.clstOrdersMouseDown()'); 1197 1239 raise; 1198 1240 end; … … 1225 1267 if clstOrders.Selected[i] then 1226 1268 begin 1227 thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);1228 1229 //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK1269 thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]); 1270 1271 //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK 1230 1272 if thisChangeItem = nil then 1231 1273 begin 1232 Copy1.Enabled := false;1233 buOrdersDiagnosis.Enabled := false;1234 Exit;1274 Copy1.Enabled := false; 1275 buOrdersDiagnosis.Enabled := false; 1276 Exit; 1235 1277 end; 1236 1278 1237 1279 if (thisChangeItem <> nil) then //Blank row - not an order item 1238 1280 begin 1239 thisOrderList.Clear;1240 thisOrderList.Add(thisChangeItem.ID);1241 1242 if IsAllOrdersNA(thisOrderList) then1243 begin1244 Diagnosis1.Enabled := false;1245 buOrdersDiagnosis.Enabled := false;1246 end1281 thisOrderList.Clear; 1282 thisOrderList.Add(thisChangeItem.ID); 1283 1284 if IsAllOrdersNA(thisOrderList) then 1285 begin 1286 Diagnosis1.Enabled := false; 1287 buOrdersDiagnosis.Enabled := false; 1288 end 1247 1289 else 1248 1290 begin … … 1268 1310 j: integer; //CQ5054 1269 1311 begin 1270 1271 if FOSTFHintWndActive then 1272 begin 1273 FOSTFhintWindow.ReleaseHandle ; 1274 FOSTFHintWndActive := False ; 1275 end; 1276 1277 case Key of 1278 67,99: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.Label24); //C,c 1279 86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.staticText4); //V,v 1280 79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.Label18); //O,o 1281 82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.Label16); //R,r 1282 69,101: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.Label14); //E,e 1283 77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.Label12); //M,m 1284 72,104: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //H,h 1285 //CQ5054 1286 83,115: if (ssAlt in Shift) then 1287 begin 1288 for j := 0 to clstOrders.Items.Count-1 do 1289 clstOrders.Selected[j] := false; 1290 clstOrders.Selected[0] := true; 1291 clstOrders.SetFocus; 1292 end; 1293 //end CQ5054 1294 end; 1312 inherited; 1313 if FOSTFHintWndActive then 1314 begin 1315 FOSTFhintWindow.ReleaseHandle ; 1316 FOSTFHintWndActive := False ; 1317 end; 1318 1319 case Key of 1320 67,99: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.lblSC2); //C,c 1321 86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.lblCV2); //V,v 1322 79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.lblAO2); //O,o 1323 82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.lblIR2); //R,r 1324 65,97: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.lblSWAC2); //A,a 1325 77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.lblMST2); //M,m 1326 78,110: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //N,n 1327 72,104: if (ssALT in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSHAD,fraCopay.lblSHAD2); // H,h 1328 //CQ5054 1329 83,115: if (ssAlt in Shift) then 1330 begin 1331 for j := 0 to clstOrders.Items.Count-1 do 1332 clstOrders.Selected[j] := false; 1333 clstOrders.Selected[0] := true; 1334 clstOrders.SetFocus; 1335 end; 1336 //end CQ5054 1337 end; 1295 1338 end; 1296 1339 1297 1340 //BILLING AWARE Procedure 1298 procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: T ORStaticText); // 5081341 procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508 1299 1342 var 1300 1343 HRect: TRect; … … 1306 1349 if FOSTFhintWndActive then 1307 1350 begin 1308 FOSTFhintWindow.ReleaseHandle;1309 FOSTFhintWndActive := False;1351 FOSTFhintWindow.ReleaseHandle; 1352 FOSTFhintWndActive := False; 1310 1353 end; 1311 1354 except 1312 1355 on E: Exception do 1313 1356 begin 1314 {$ifdef debug}Show Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}1357 {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif} 1315 1358 raise; 1316 1359 end; … … 1329 1372 hrect.Bottom := hrect.Bottom + Y; 1330 1373 1331 if FOSTFHintWndActive then 1332 begin 1333 with fraCoPay do 1334 begin 1335 //Abbreviated captions 1336 Label23.ShowHint := false; 1337 StaticText1.ShowHint := false; 1338 Label17.ShowHint := false; 1339 Label15.ShowHint := false; 1340 Label13.ShowHint := false; 1341 Label11.ShowHint := false; 1342 lblHNC.ShowHint := false; 1343 //Long captions 1344 staticText4.ShowHint := false; 1345 Label17.ShowHint := false; 1346 Label18.ShowHint := false; 1347 Label15.ShowHint := false; 1348 Label16.ShowHint := false; 1349 Label13.ShowHint := false; 1350 Label14.ShowHint := false; 1351 Label11.ShowHint := false; 1352 Label12.ShowHint := false; 1353 lblHNC.ShowHint := false; 1354 lblHNC2.ShowHint := false; 1355 end; 1356 end 1357 else 1358 begin 1359 with fraCoPay do 1360 begin 1361 //Abbreviated captions 1362 Label23.ShowHint := true; 1363 StaticText1.ShowHint := true; 1364 Label17.ShowHint := true; 1365 Label15.ShowHint := true; 1366 Label13.ShowHint := true; 1367 Label11.ShowHint := true; 1368 lblHNC.ShowHint := true; 1369 //Long captions 1370 staticText4.ShowHint := true; 1371 Label17.ShowHint := true; 1372 Label18.ShowHint := true; 1373 Label15.ShowHint := true; 1374 Label16.ShowHint := true; 1375 Label13.ShowHint := true; 1376 Label14.ShowHint := true; 1377 Label11.ShowHint := true; 1378 Label12.ShowHint := true; 1379 lblHNC.ShowHint := true; 1380 lblHNC2.ShowHint := true; 1381 end; 1382 end; 1374 fraCoPay.LabelCaptionsOn(not FOSTFHintWndActive); 1383 1375 1384 1376 FOSTFhintWindow.ActivateHint(hrect, pHintText); … … 1387 1379 on E: Exception do 1388 1380 begin 1389 {$ifdef debug}Show Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}1381 {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif} 1390 1382 raise; 1391 1383 end; … … 1405 1397 on E: Exception do 1406 1398 begin 1407 {$ifdef debug}Show Message('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}1399 {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif} 1408 1400 raise; 1409 1401 end; … … 1411 1403 end; 1412 1404 1405 procedure TfrmSignOrders.FormResize(Sender: TObject); 1406 begin 1407 inherited; 1408 clstOrders.invalidate; 1409 end; 1410 1413 1411 procedure TfrmSignOrders.fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 1414 1412 begin 1415 if FOSTFHintWndActive then 1416 begin 1417 with fraCoPay do 1418 begin 1419 //Abbreviated captions 1420 Label23.ShowHint := false; 1421 StaticText1.ShowHint := false; 1422 Label17.ShowHint := false; 1423 Label15.ShowHint := false; 1424 Label13.ShowHint := false; 1425 Label11.ShowHint := false; 1426 lblHNC.ShowHint := false; 1427 //Long captions 1428 Label24.ShowHint := false; 1429 staticText4.ShowHint := false; 1430 Label17.ShowHint := false; 1431 Label18.ShowHint := false; 1432 Label15.ShowHint := false; 1433 Label16.ShowHint := false; 1434 Label13.ShowHint := false; 1435 Label14.ShowHint := false; 1436 Label11.ShowHint := false; 1437 Label12.ShowHint := false; 1438 lblHNC.ShowHint := false; 1439 lblHNC2.ShowHint := false; 1440 end; 1441 end 1442 else 1443 begin 1444 with fraCoPay do 1445 begin 1446 //Abbreviated captions 1447 Label23.ShowHint := true; 1448 StaticText1.ShowHint := true; 1449 Label17.ShowHint := true; 1450 Label15.ShowHint := true; 1451 Label13.ShowHint := true; 1452 Label11.ShowHint := true; 1453 lblHNC.ShowHint := true; 1454 //Long captions 1455 Label24.ShowHint := true; 1456 staticText4.ShowHint := true; 1457 Label17.ShowHint := true; 1458 Label18.ShowHint := true; 1459 Label15.ShowHint := true; 1460 Label16.ShowHint := true; 1461 Label13.ShowHint := true; 1462 Label14.ShowHint := true; 1463 Label11.ShowHint := true; 1464 Label12.ShowHint := true; 1465 lblHNC.ShowHint := true; 1466 lblHNC2.ShowHint := true; 1467 end; 1468 end; 1469 1413 fraCoPay.LabelCaptionsOn(not FOSTFHintWndActive) 1470 1414 end; 1471 1415 1472 1416 procedure TfrmSignOrders.fraCoPayLabel23Enter(Sender: TObject); 1473 1417 begin 1474 (Sender as T ORStaticText).Font.Style := [fsBold];1418 (Sender as TVA508StaticText).Font.Style := [fsBold]; 1475 1419 end; 1476 1420 1477 1421 procedure TfrmSignOrders.fraCoPayLabel23Exit(Sender: TObject); 1478 1422 begin 1479 (Sender as T ORStaticText).Font.Style := [];1423 (Sender as TVA508StaticText).Font.Style := []; 1480 1424 end; 1481 1425 … … 1512 1456 1513 1457 procedure TfrmSignOrders.FormatListForScreenReader; 1514 var 1515 ListStateOn : longbool; 1516 Success: longbool; 1517 begin 1518 //Determine if a screen reader is currently being used. 1519 Success := SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0); 1520 if Success and ListStateOn then 1458 begin 1459 if ScreenReaderActive then 1521 1460 SetItemTextToState; 1522 1461 end; -
cprs/trunk/CPRS-Chart/Orders/fOrdersTS.dfm
r456 r829 2 2 Left = 84 3 3 Top = 77 4 Width = 4645 Height = 3856 4 Caption = 'Release Orders' 5 ClientHeight = 351 6 ClientWidth = 456 7 7 Constraints.MinHeight = 365 8 8 Constraints.MinWidth = 310 9 9 OnClose = FormClose 10 10 OnCreate = FormCreate 11 OnKeyDown = FormKeyDown 11 ExplicitLeft = 84 12 ExplicitTop = 77 13 ExplicitWidth = 464 14 ExplicitHeight = 385 12 15 PixelsPerInch = 96 13 16 TextHeight = 13 14 object pnlMiddle: TPanel 17 object pnlMiddle: TPanel [0] 15 18 Left = 0 16 19 Top = 78 … … 36 39 Width = 333 37 40 Height = 17 38 BiDiMode = bdRightToLeft39 41 Caption = ' &Release new orders immediately' 40 42 Enabled = False 41 ParentBiDiMode = False42 43 TabOrder = 0 43 44 OnClick = radReleaseNowClick … … 76 77 end 77 78 end 78 object pnlTop: TPanel 79 object pnlTop: TPanel [1] 79 80 Left = 0 80 81 Top = 0 … … 89 90 Left = 1 90 91 Top = 1 91 Width = 45092 Width = 3 92 93 Height = 34 93 94 Align = alTop … … 109 110 Top = 1 110 111 Width = 24 111 Height = 36112 Height = 22 112 113 Align = alLeft 113 114 AutoSize = True … … 128 129 00000000000000000008} 129 130 Transparent = True 131 ExplicitHeight = 36 130 132 end 131 133 object Label1: TLabel … … 149 151 end 150 152 end 151 object Panel1: TPanel 153 object Panel1: TPanel [2] 152 154 Left = 0 153 155 Top = 134 154 156 Width = 456 155 Height = 2 24157 Height = 217 156 158 Align = alClient 157 159 TabOrder = 2 … … 160 162 Top = 1 161 163 Width = 454 162 Height = 2 22164 Height = 215 163 165 Align = alClient 164 AutoScroll = False166 AutoScroll = True 165 167 TabOrder = 0 168 TabStop = True 166 169 Visible = False 170 ExplicitLeft = 1 171 ExplicitTop = 1 172 ExplicitWidth = 454 173 ExplicitHeight = 215 167 174 inherited pnlDate: TPanel 168 175 Left = 349 169 Height = 222 176 Height = 215 177 ExplicitLeft = 349 178 ExplicitHeight = 215 170 179 inherited lblEffective: TLabel 171 180 Left = 453 181 Width = 71 182 ExplicitLeft = 453 183 ExplicitWidth = 71 172 184 end 173 185 inherited orDateBox: TORDateBox 174 186 Left = 453 187 ExplicitLeft = 453 175 188 end 176 189 end 177 190 inherited pnlList: TPanel 178 191 Width = 349 179 Height = 222 192 Height = 215 193 ExplicitWidth = 349 194 ExplicitHeight = 215 180 195 inherited lblEvntDelayList: TLabel 181 196 Width = 347 197 ExplicitWidth = 80 182 198 end 183 199 inherited mlstEvents: TORListBox 184 200 Width = 347 185 Height = 1 86201 Height = 179 186 202 OnDblClick = cmdOKClick 203 ExplicitWidth = 347 204 ExplicitHeight = 179 187 205 end 188 206 inherited edtSearch: TCaptionEdit 189 207 Width = 347 190 end 191 end 192 end 208 ExplicitWidth = 347 209 end 210 end 211 end 212 end 213 inherited amgrMain: TVA508AccessibilityManager 214 Data = ( 215 ( 216 'Component = pnlMiddle' 217 'Status = stsDefault') 218 ( 219 'Component = grpChoice' 220 'Status = stsDefault') 221 ( 222 'Component = radReleaseNow' 223 'Status = stsDefault') 224 ( 225 'Component = radDelayed' 226 'Status = stsDefault') 227 ( 228 'Component = cmdOK' 229 'Status = stsDefault') 230 ( 231 'Component = cmdCancel' 232 'Status = stsDefault') 233 ( 234 'Component = pnlTop' 235 'Status = stsDefault') 236 ( 237 'Component = pnldif' 238 'Status = stsDefault') 239 ( 240 'Component = Panel1' 241 'Status = stsDefault') 242 ( 243 'Component = fraEvntDelayList' 244 'Status = stsDefault') 245 ( 246 'Component = fraEvntDelayList.pnlDate' 247 'Status = stsDefault') 248 ( 249 'Component = fraEvntDelayList.orDateBox' 250 'Status = stsDefault') 251 ( 252 'Component = fraEvntDelayList.pnlList' 253 'Status = stsDefault') 254 ( 255 'Component = fraEvntDelayList.mlstEvents' 256 'Status = stsDefault') 257 ( 258 'Component = fraEvntDelayList.edtSearch' 259 'Status = stsDefault') 260 ( 261 'Component = frmOrdersTS' 262 'Status = stsDefault')) 193 263 end 194 264 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersTS.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst; 7 fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst, 8 VA508AccessibilityManager; 8 9 9 10 type -
cprs/trunk/CPRS-Chart/Orders/fOrdersUnhold.dfm
r456 r829 2 2 Left = 269 3 3 Top = 192 4 Height = 2705 4 Caption = 'Release Orders from Hold' 5 ClientHeight = 243 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitWidth = 320 9 ExplicitHeight = 270 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 10 object Label1: TLabel 12 object Label1: TLabel [0] 11 13 Left = 8 12 14 Top = 8 … … 15 17 Caption = 'The following orders will be released from hold -' 16 18 end 17 object lstOrders: TCaptionListBox 19 object lstOrders: TCaptionListBox [1] 18 20 Left = 8 19 21 Top = 22 … … 24 26 Caption = 'The following orders will be released from hold ' 25 27 end 26 object cmdOK: TButton 28 object cmdOK: TButton [2] 27 29 Left = 267 28 30 Top = 214 … … 34 36 OnClick = cmdOKClick 35 37 end 36 object cmdCancel: TButton 38 object cmdCancel: TButton [3] 37 39 Left = 347 38 40 Top = 214 … … 44 46 OnClick = cmdCancelClick 45 47 end 48 inherited amgrMain: TVA508AccessibilityManager 49 Data = ( 50 ( 51 'Component = lstOrders' 52 'Status = stsDefault') 53 ( 54 'Component = cmdOK' 55 'Status = stsDefault') 56 ( 57 'Component = cmdCancel' 58 'Status = stsDefault') 59 ( 60 'Component = frmUnholdOrders' 61 'Status = stsDefault')) 62 end 46 63 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersUnhold.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls ;7 fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager; 8 8 9 9 type -
cprs/trunk/CPRS-Chart/Orders/fOrdersVerify.dfm
r456 r829 2 2 Left = 341 3 3 Top = 182 4 Height = 3675 4 Caption = 'Verify Orders' 5 ClientHeight = 340 6 6 Position = poScreenCenter 7 7 OnCreate = FormCreate 8 ExplicitWidth = 320 9 ExplicitHeight = 367 8 10 PixelsPerInch = 96 9 11 TextHeight = 13 10 object Panel1: TPanel 12 object Panel1: TPanel [0] 11 13 Left = 0 12 14 Top = 0 … … 27 29 Align = alTop 28 30 Caption = 'The following orders will be marked as verified -' 31 ExplicitWidth = 222 29 32 end 30 33 object lstOrders: TCaptionListBox … … 43 46 end 44 47 end 45 object Panel2: TPanel 48 object Panel2: TPanel [1] 46 49 Left = 0 47 50 Top = 293 … … 87 90 end 88 91 end 92 inherited amgrMain: TVA508AccessibilityManager 93 Data = ( 94 ( 95 'Component = Panel1' 96 'Status = stsDefault') 97 ( 98 'Component = lstOrders' 99 'Status = stsDefault') 100 ( 101 'Component = Panel2' 102 'Status = stsDefault') 103 ( 104 'Component = txtESCode' 105 'Status = stsDefault') 106 ( 107 'Component = cmdOK' 108 'Status = stsDefault') 109 ( 110 'Component = cmdCancel' 111 'Status = stsDefault') 112 ( 113 'Component = frmVerifyOrders' 114 'Status = stsDefault')) 115 end 89 116 end -
cprs/trunk/CPRS-Chart/Orders/fOrdersVerify.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls ;7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager; 8 8 9 9 type … … 127 127 x := FilteredString(Items[Index]); 128 128 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect); 129 //if AHeight > 255 then AHeight := 255;130 129 if AHeight < 13 then AHeight := 15; 131 130 end; … … 145 144 ARect.Left := ARect.Left + 2; 146 145 Canvas.FillRect(ARect); 147 Canvas.Pen.Color := clSilver;146 Canvas.Pen.Color := Get508CompliantColor(clSilver); 148 147 SaveColor := Canvas.Brush.Color; 149 148 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); -
cprs/trunk/CPRS-Chart/Orders/fOtherSchedule.dfm
r456 r829 1 objectfrmOtherSchedule: TfrmOtherSchedule1 inherited frmOtherSchedule: TfrmOtherSchedule 2 2 Left = 544 3 3 Top = 262 4 AutoScroll = False5 4 Caption = 'Order with schedule '#39'OTHER'#39 6 5 ClientHeight = 362 7 ClientWidth = 369 8 Color = clBtnFace 6 ClientWidth = 592 9 7 Constraints.MinHeight = 70 10 8 Constraints.MinWidth = 280 11 Font.Charset = DEFAULT_CHARSET12 Font.Color = clWindowText13 Font.Height = -1114 Font.Name = 'MS Sans Serif'15 Font.Style = []16 9 OldCreateOrder = False 17 10 Position = poOwnerFormCenter 18 11 OnClose = FormClose 19 12 OnCreate = FormCreate 13 ExplicitWidth = 600 14 ExplicitHeight = 389 20 15 PixelsPerInch = 96 21 16 TextHeight = 13 22 object Splitter1: TSplitter 17 object Splitter1: TSplitter [0] 23 18 Left = 0 24 19 Top = 82 25 Width = 36920 Width = 592 26 21 Height = 8 27 22 Cursor = crVSplit … … 29 24 Beveled = True 30 25 MinSize = 1 26 ExplicitWidth = 369 31 27 end 32 object Panel1: TPanel 28 object Panel1: TPanel [1] 33 29 Left = 0 34 30 Top = 0 35 Width = 36931 Width = 592 36 32 Height = 82 37 33 Align = alTop … … 50 46 Left = 52 51 47 Top = 4 52 Width = 31348 Width = 536 53 49 Height = 74 54 50 Align = alClient … … 61 57 end 62 58 end 63 object Panel3: TPanel 59 object Panel3: TPanel [2] 64 60 Left = 0 65 61 Top = 90 66 Width = 36962 Width = 592 67 63 Height = 272 68 64 Align = alClient … … 162 158 Width = 188 163 159 Height = 202 164 Align = alRight165 160 Caption = 'Set Administration Time' 166 161 TabOrder = 1 … … 250 245 Left = 1 251 246 Top = 203 252 Width = 367247 Width = 590 253 248 Height = 68 254 249 Align = alBottom 255 TabOrder = 2250 TabOrder = 3 256 251 DesignSize = ( 257 367252 590 258 253 68) 259 254 object Label1: TLabel … … 265 260 end 266 261 object btn0k1: TButton 267 Left = 204262 Left = 427 268 263 Top = 43 269 264 Width = 75 … … 275 270 end 276 271 object btnCancel: TButton 277 Left = 285272 Left = 508 278 273 Top = 42 279 274 Width = 75 … … 285 280 OnClick = btnCancelClick 286 281 end 287 object txtSchedule: TEdit288 Left = 64289 Top = 8290 Width = 296291 Height = 21292 Anchors = [akLeft, akTop, akRight]293 Color = clInfoBk294 Enabled = False295 Font.Charset = DEFAULT_CHARSET296 Font.Color = clWindowText297 Font.Height = -11298 Font.Name = 'MS Sans Serif'299 Font.Style = [fsBold]300 ParentFont = False301 ReadOnly = True302 TabOrder = 0303 OnChange = txtScheduleChange304 end305 282 object btnReset: TButton 306 283 Left = 8 … … 312 289 OnClick = btnResetClick 313 290 end 314 end 291 object txtSchedule: TEdit 292 Left = 63 293 Top = 6 294 Width = 520 295 Height = 21 296 Color = clInfoBk 297 ReadOnly = True 298 TabOrder = 0 299 end 300 end 301 object GroupBox3: TGroupBox 302 Left = 374 303 Top = -2 304 Width = 211 305 Height = 202 306 Caption = 'Schedule' 307 TabOrder = 2 308 object NSScboSchedule: TORComboBox 309 Left = 5 310 Top = 16 311 Width = 121 312 Height = 180 313 Style = orcsSimple 314 AutoSelect = True 315 Color = clWindow 316 DropDownCount = 8 317 ItemHeight = 13 318 ItemTipColor = clWindow 319 ItemTipEnable = True 320 ListItemsOnly = False 321 LongList = False 322 LookupPiece = 1 323 MaxLength = 0 324 Pieces = '1' 325 Sorted = False 326 SynonymChars = '<>' 327 TabOrder = 0 328 CharsNeedMatch = 1 329 UniqueAutoComplete = True 330 end 331 object btnSchAdd: TButton 332 Left = 132 333 Top = 64 334 Width = 60 335 Height = 19 336 Caption = 'Add' 337 TabOrder = 1 338 OnClick = btnSchAddClick 339 end 340 object btnSchRemove: TButton 341 Left = 132 342 Top = 94 343 Width = 60 344 Height = 19 345 Caption = 'Remove' 346 TabOrder = 2 347 OnClick = btnSchRemoveClick 348 end 349 end 350 end 351 inherited amgrMain: TVA508AccessibilityManager 352 Data = ( 353 ( 354 'Component = Panel1' 355 'Status = stsDefault') 356 ( 357 'Component = memMessage' 358 'Status = stsDefault') 359 ( 360 'Component = Panel3' 361 'Status = stsDefault') 362 ( 363 'Component = GroupBox1' 364 'Status = stsDefault') 365 ( 366 'Component = cbo7' 367 'Status = stsDefault') 368 ( 369 'Component = cbo1' 370 'Status = stsDefault') 371 ( 372 'Component = cbo2' 373 'Status = stsDefault') 374 ( 375 'Component = cbo3' 376 'Status = stsDefault') 377 ( 378 'Component = cbo4' 379 'Status = stsDefault') 380 ( 381 'Component = cbo5' 382 'Status = stsDefault') 383 ( 384 'Component = cbo6' 385 'Status = stsDefault') 386 ( 387 'Component = Button1' 388 'Status = stsDefault') 389 ( 390 'Component = GroupBox2' 391 'Status = stsDefault') 392 ( 393 'Component = lstHour' 394 'Status = stsDefault') 395 ( 396 'Component = lstMinute' 397 'Status = stsDefault') 398 ( 399 'Component = btnRemove' 400 'Status = stsDefault') 401 ( 402 'Component = btnAdd' 403 'Status = stsDefault') 404 ( 405 'Component = Panel4' 406 'Status = stsDefault') 407 ( 408 'Component = btn0k1' 409 'Status = stsDefault') 410 ( 411 'Component = btnCancel' 412 'Status = stsDefault') 413 ( 414 'Component = btnReset' 415 'Status = stsDefault') 416 ( 417 'Component = GroupBox3' 418 'Status = stsDefault') 419 ( 420 'Component = NSScboSchedule' 421 'Status = stsDefault') 422 ( 423 'Component = btnSchAdd' 424 'Status = stsDefault') 425 ( 426 'Component = btnSchRemove' 427 'Status = stsDefault') 428 ( 429 'Component = frmOtherSchedule' 430 'Status = stsDefault') 431 ( 432 'Component = txtSchedule' 433 'Status = stsDefault')) 315 434 end 316 435 end -
cprs/trunk/CPRS-Chart/Orders/fOtherSchedule.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, fAutoSz, rMisc; 7 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, fAutoSz, rMisc, ORCtrls, rODMeds, 8 VA508AccessibilityManager, VAUtils; 8 9 9 10 const … … 29 30 btn0k1: TButton; 30 31 btnCancel: TButton; 31 txtSchedule: TEdit;32 32 Label1: TLabel; 33 33 btnReset: TButton; … … 37 37 btnAdd: TButton; 38 38 Button1: TButton; 39 GroupBox3: TGroupBox; 40 NSScboSchedule: TORComboBox; 41 btnSchAdd: TButton; 42 btnSchRemove: TButton; 43 txtSchedule: TEdit; 39 44 procedure FormCreate(Sender: TObject); 40 45 procedure btnCancelClick(Sender: TObject); … … 58 63 Shift: TShiftState); 59 64 procedure Button1Click(Sender: TObject); 65 procedure btnSchAddClick(Sender: TObject); 66 procedure btnSchRemoveClick(Sender: TObject); 67 procedure FormDestroy(Sender: TObject); 60 68 private 61 69 FDaySchedule: array [1..7] of string; 62 70 FTimeSchedule: TStringList; 71 FSchedule: String; 63 72 FOtherSchedule: String; 64 73 FFromCheckBox: boolean; … … 67 76 procedure SetDaySchedule(Sender: TObject); 68 77 procedure SetTimeSchedule; 78 procedure SetScheduleSelection; 69 79 procedure UpdateOnFreeTextInput; 80 procedure EnabledTime(TF: boolean); 81 procedure EnabledSch(TF: boolean); 70 82 function CheckDay(ADayStr: string): string; 71 83 … … 75 87 function ShowOtherSchedule(var ASchedule: string): boolean; 76 88 89 var 90 frmOtherSchedule: TfrmOtherSchedule; 91 77 92 implementation 78 93 … … 80 95 {$R *.dfm} 81 96 82 function ShowOtherSchedule(var ASchedule: string): boolean; 83 var 84 frmOtherSchedule: TfrmOtherSchedule; 97 function ShowOtherSchedule(var ASchedule: string): 98 99 boolean; 100 var 101 102 AdminTime, SchType: string; 85 103 begin 86 104 Result := False; 87 105 try 106 ASchedule := ''; 88 107 frmOtherSchedule := TfrmOtherSchedule.Create(Application); 89 108 ResizeFormToFont(TForm(frmOtherSchedule)); … … 92 111 begin 93 112 ASchedule := UpperCase(frmOtherSchedule.FOtherSchedule); 113 if frmOtherSchedule.GroupBox3.Enabled = True then 114 begin 115 AdminTime := Piece(frmOtherSchedule.NSScboSchedule.Items.Strings[frmOtherSchedule.NSScboSchedule.itemindex],U,4); 116 schType := Piece(frmOtherSchedule.NSScboSchedule.Items.Strings[frmOtherSchedule.NSScboSchedule.itemindex],U,3); 117 ASchedule := ASchedule + U + AdminTime + U + schType; 118 //if (schType = 'P') or (schType = 'OC') then ASchedule := ASchedule + U + '1' 119 //else ASchedule := ASchedule + U + '0'; 120 end 121 else if frmOtherSchedule.GroupBox2.Enabled = true then 122 begin 123 AdminTime := Piece(ASchedule,'@',2); 124 ASchedule := ASchedule + U + AdminTime + U + 'C'; 125 end; 94 126 Result := True; 95 127 end; 96 128 except 97 ShowM essage('Error happen when building other schedule');129 ShowMsg('Error happen when building other schedule'); 98 130 end; 99 131 end; … … 105 137 nssMsg: string; 106 138 begin 139 frmOtherSchedule := nil; 107 140 FFromCheckBox := False; 108 141 FFromEditBox := False; … … 111 144 FDaySchedule[i] := ''; 112 145 FTimeSchedule := TStringlist.Create; 146 FSchedule := ''; 113 147 FOtherSchedule := ''; 114 148 nssMsg := GetSiteMessage; … … 116 150 nssMsg := NSS_TXT; 117 151 memMessage.Lines.Add(nssMsg); 152 LoadDOWSchedules(NSScboSchedule.Items); 153 if ScreenReaderActive = false then txtSchedule.TabStop := false; 154 155 end; 156 157 procedure TfrmOtherSchedule.FormDestroy(Sender: TObject); 158 begin 159 inherited; 160 //FDaySchedule 161 FTimeSchedule.Free; 162 frmOtherSchedule := nil; 163 //FSchedule: String; 164 //FOtherSchedule: String; 118 165 end; 119 166 120 167 procedure TfrmOtherSchedule.btnCancelClick(Sender: TObject); 121 168 begin 122 modalResult := mrCancel;169 frmOtherSchedule.Release; 123 170 end; 124 171 … … 128 175 (cbo6.Checked = false) and (cbo7.Checked = false) then 129 176 begin 130 ShowM essage('A day of week must be selected!');177 ShowMsg('A day of week must be selected!'); 131 178 Exit; 132 179 end; 133 if not IsValidSchStr(FOtherSchedule) then 134 begin 135 ShowMessage('The schedule you entered is invalid!'); 180 if Pos('@', self.txtSchedule.Text) = 0 then 181 begin 182 ShowMsg('An Administation Time or a schedule needs to be selected'); 183 exit; 184 end; 185 (* if not IsValidSchStr(FOtherSchedule) then 186 begin 187 Show508Message('The schedule you entered is invalid!'); 136 188 Exit; 137 end; 189 end; *) 138 190 modalResult := mrOK; 139 191 end; … … 142 194 var 143 195 i : integer; 144 TimePart, DayPart : string;196 TimePart, DayPart, Schedule: string; 145 197 begin 146 198 with (Sender as TCheckBox) do … … 152 204 FDaySchedule[TCheckBox(Sender).Tag] := ''; 153 205 except 154 ShowM essage('Error happened when building day schedule.');206 ShowMsg('Error happened when building day schedule.'); 155 207 Exit; 156 208 end; … … 159 211 TimePart := ''; 160 212 DayPart := ''; 161 for i := 0 to FTimeSchedule.Count - 1 do 162 begin 163 if i = 0 then TimePart := TimePart + FTimeSchedule[i] 164 else TimePart := TimePart + '-' + FTimeSchedule[i]; 165 end; 213 schedule := ''; 214 if Self.GroupBox2.Enabled = True then 215 begin 216 for i := 0 to FTimeSchedule.Count - 1 do 217 begin 218 if i = 0 then TimePart := TimePart + FTimeSchedule[i] 219 else TimePart := TimePart + '-' + FTimeSchedule[i]; 220 end; 221 end; 222 if (self.GroupBox3.Enabled = True) and (FSchedule <> '') then schedule := FSchedule; 166 223 for i := Low(FDaySchedule) to High(FDaySchedule) do 167 224 begin … … 179 236 FOtherSchedule := TimePart; 180 237 end 238 else if Length(schedule) > 0 then 239 begin 240 if length(DayPart) > 0 then 241 FOtherSchedule := DayPart + '@' + Schedule 242 else if Length(DayPart) = 0 then 243 FOtherSchedule := Schedule; 244 end 181 245 else FOtherSchedule := DayPart; 246 txtSchedule.Text := FOtherSchedule; 247 end; 248 249 250 procedure TfrmOtherSchedule.SetScheduleSelection; 251 var 252 i: integer; 253 DayPart: string; 254 begin 255 DayPart := ''; 256 for i := Low(FDaySchedule) to High(FDaySchedule) do 257 begin 258 if Length(FDaySchedule[i])>0 then 259 begin 260 if DayPart = '' then DayPart := FDaySchedule[i] 261 else DayPart := DayPart + '-' + FDaySchedule[i]; 262 end; 263 end; 264 if Length(DayPart) > 0 then 265 begin 266 if FSchedule <> '' then 267 FOtherSchedule := DayPart + '@' + FSchedule 268 else 269 FOtherSchedule := DayPart; 270 end 271 else FOtherSchedule := FSchedule; 272 //if Length(APRN) > 0 then FOtherSchedule := FOtherSchedule; 182 273 txtSchedule.Text := FOtherSchedule; 183 274 end; … … 278 369 hour, min: string; 279 370 begin 371 if FSchedule <> '' then Exit; 280 372 if lstHour.ItemIndex < 0 then exit; 281 373 hour := lstHour.Items[lstHour.ItemIndex]; … … 298 390 FTimeSchedule.Sort; 299 391 SetTimeSchedule; 392 if FTimeSchedule.Count > 0 then EnabledSch(False); 300 393 end; 301 394 … … 313 406 lstHour.ItemIndex := -1; 314 407 lstMinute.ItemIndex := -1; 408 NSScboSchedule.ItemIndex := -1; 315 409 for i := low(FDaySchedule) to high(FDaySchedule) do 316 410 FDaySchedule[i] := ''; … … 318 412 FOtherSchedule := ''; 319 413 txtSchedule.Text := ''; 414 FSchedule := ''; 415 EnabledTime(True); 416 EnabledSch(True); 417 end; 418 419 procedure TfrmOtherSchedule.btnSchAddClick(Sender: TObject); 420 begin 421 inherited; 422 if self.NSScboSchedule.ItemIndex < 0 then Exit; 423 if FSchedule <> '' then 424 begin 425 infoBox('A Day-of-week schedule can only contain one schedule','Warning',MB_OK); 426 Exit; 427 end; 428 FSchedule := self.NSScboSchedule.Text; 429 SetScheduleSelection; 430 Self.NSScboSchedule.Enabled := False; 431 EnabledTime(False); 432 end; 433 434 procedure TfrmOtherSchedule.btnSchRemoveClick(Sender: TObject); 435 begin 436 inherited; 437 if (FSchedule = '') or (self.NSScboSchedule.ItemIndex < 0) then exit; 438 if self.NSScboSchedule.Text <> FSchedule then exit; 439 Fschedule := ''; 440 SetScheduleSelection; 441 self.NSScboSchedule.Enabled := True; 442 EnabledTime(True); 320 443 end; 321 444 … … 346 469 SetTimeSchedule; 347 470 FFromCheckBox := False; 471 if FTimeSchedule.Count = 0 then EnabledSch(True); 348 472 end; 349 473 … … 370 494 Action := caFree; 371 495 end; 496 //frmOtherSchedule := nil; 372 497 end; 373 498 … … 523 648 end; 524 649 650 procedure TfrmOtherSchedule.EnabledSch(TF: boolean); 651 begin 652 self.GroupBox3.Enabled := TF; 653 self.NSScboSchedule.Enabled := TF; 654 self.btnSchAdd.Enabled := TF; 655 self.btnSchRemove.Enabled := TF; 656 // if TF = False then self.NSScboSchedule.Color := cl3DLight 657 // else self.NSScboSchedule.Color := clWindow; 658 if TF = False then self.NSScboSchedule.ItemIndex := -1; 659 end; 660 661 procedure TfrmOtherSchedule.EnabledTime(TF: boolean); 662 begin 663 self.GroupBox2.Enabled := TF; 664 self.lstHour.Enabled := TF; 665 self.lstMinute.Enabled := TF; 666 self.btnAdd.Enabled := TF; 667 self.btnRemove.Enabled := TF; 668 if TF = False then 669 begin 670 self.lstHour.ItemIndex := -1; 671 self.lstMinute.ItemIndex := -1; 672 end; 673 end; 674 525 675 procedure TfrmOtherSchedule.lstMinuteMouseUp(Sender: TObject; 526 676 Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -
cprs/trunk/CPRS-Chart/Orders/rODAllergy.pas
r456 r829 5 5 interface 6 6 7 uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc ;7 uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc,fNotes ; 8 8 9 9 type … … 71 71 function EnableErrorComments: boolean; 72 72 function IsARTClinicalUser(var AMessage: string): boolean; 73 function GetAllergyTitleText: string; 73 74 74 75 implementation … … 169 170 i: integer; 170 171 begin 172 171 173 with RPCBrokerV, EditRec do 172 174 begin … … 215 217 Mult['"GMRAERRCMTS",' + IntToStr(i+1)] := Strings[i]; 216 218 end; 219 217 220 end ; 218 221 with ChartMarked do if Count > 0 then … … 241 244 end; 242 245 end; 243 CallBroker; 244 Result := Results[0]; 245 end; 246 CallBroker; 247 Result := Results[0]; 248 // Include "Allergy Entered in Error" items require signature list. 249 //cq-8002 -piece 2 is Allergy Entered in Error (IEN) 250 // code added allowing v27 GUI changes to continue if M change is not released prior. 251 //cq-14842 - add observed/drug allergies to the fReview/fSignOrders forms for signature. 252 if Length(Piece(Result,'^',2))> 0 then 253 Changes.Add(10, Piece(Result,'^',2), GetAllergyTitleText, '', 1) 254 else 255 exit; 256 end; 246 257 end; 247 258 … … 363 374 end; 364 375 376 function GetAllergyTitleText: string; 377 begin 378 Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(floatToStr(FMToday))) + 379 ' ' + 'Adverse React/Allergy' + ', ' + Encounter.LocationName + ', ' + User.Name; 380 end; 381 365 382 end. -
cprs/trunk/CPRS-Chart/Orders/rODBase.pas
r456 r829 1 1 unit rODBase; 2 2 3 interface 3 interface 4 4 5 5 uses SysUtils, Windows, Classes, ORNet, ORFn, uCore, uConst, rOrders; … … 132 132 implementation 133 133 134 uses TRPCB, uOrders, uODBase ;134 uses TRPCB, uOrders, uODBase, fODBase; 135 135 136 136 var … … 182 182 begin 183 183 IVDurVal := Copy(IVDuration,1,length(IVDuration)-1); 184 TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' hours';184 TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' hours'; 185 185 end 186 186 else if (Pos('D',upperCase(IVDuration))>0) then 187 187 begin 188 IVDurVal := Copy(IVDuration,1,length(IVDuration)-1); 189 TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'days'; 188 if Pos('DOSES', upperCase(IVDuration)) > 0 then 189 begin 190 IVDurVal := Copy(IVDuration, 1, length(IVDuration)-5); 191 TResponse(ResponseList.Items[j]).IValue := 'for a total of ' + IVDurVal + ' doses'; 192 end 193 else 194 begin 195 IVDurVal := Copy(IVDuration,1,length(IVDuration)-1); 196 TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' days'; 197 end; 190 198 end 191 199 else if ((Pos('ML',upperCase(IVDuration))>0) or (Pos('CC',upperCase(IVDuration))>0)) then … … 245 253 begin 246 254 CallV('ORWDXQ GETQLST', [DGroup]); 247 Dest.Assign(RPCBrokerV.Results);255 FastAssign(RPCBrokerV.Results, Dest); 248 256 end; 249 257 … … 389 397 HasObjects := FALSE; 390 398 TempBroker := TStringlist.Create; 391 TempBroker.Assign(RPCBrokerV.Results);399 FastAssign(RPCBrokerV.Results, TempBroker); 392 400 try 393 401 with TempBroker do while i < Count do … … 427 435 428 436 procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean); 429 begin 430 CallV('ORWDX LOADRSP', [OrderID]); 437 var 438 Transfer: boolean; 439 begin 440 if ((XferOuttoInOnMeds = True) or (XfInToOutNow = True)) and (CharAt(OrderID,1)='C') then Transfer := true 441 else Transfer := false; 442 CallV('ORWDX LOADRSP', [OrderID, Transfer]); 431 443 ExtractToResponses(Dest, HasObjects); 432 444 end; … … 704 716 begin 705 717 uMedRoutes := TStringList.Create; 706 uMedRoutes.Assign(Results);718 FastAssign(RPCBrokerV.Results, uMedRoutes); 707 719 for i := 0 to Results.Count - 1 do if Length(Piece(Results[i], U, 3)) > 0 then 708 720 begin … … 714 726 end; {with RPCBrokerV} 715 727 end; {if uMedRoutes} 716 Dest.AddStrings(uMedRoutes);728 FastAddStrings(uMedRoutes, Dest); 717 729 end; 718 730 … … 758 770 begin 759 771 CallV('ORWDPS32 FORMALT', [AnIEN, PSType]); 760 AList.Assign(RPCBrokerV.Results);772 FastAssign(RPCBrokerV.Results, AList); 761 773 end; 762 774 … … 783 795 { Returns init values for inpatient meds dialog. The results must be used immediately. } 784 796 begin 785 CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE ]);797 CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE, patient.dfn, patient.location]); 786 798 Result := RPCBrokerV.Results; 787 799 end; … … 790 802 { Returns init values for IV Fluids dialog. The results must be used immediately. } 791 803 begin 792 CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS ]);804 CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS, patient.dfn, patient.location]); 793 805 Result := RPCBrokerV.Results; 794 806 end; … … 802 814 { Returns init values for outpatient meds dialog. The results must be used immediately. } 803 815 begin 804 CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT ]);816 CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT, patient.dfn, patient.location]); 805 817 Result := RPCBrokerV.Results; 806 818 end; -
cprs/trunk/CPRS-Chart/Orders/rODDiet.pas
r456 r829 117 117 begin 118 118 CallV('ORWDFH TFPROD', [nil]); 119 Dest.AddStrings(RPCBrokerV.Results);119 FastAddStrings(RPCBrokerV.Results, Dest); 120 120 end; 121 121 … … 161 161 begin 162 162 CallV('ORWDFH ISOLIST', [nil]); 163 Dest.Assign(RPCBrokerV.Results);163 FastAssign(RPCBrokerV.Results, Dest); 164 164 end; 165 165 … … 167 167 begin 168 168 CallV('ORWDXQ GETQLST', [GroupID, 'Q']); 169 Dest.Assign(RPCBrokerV.Results);169 FastAssign(RPCBrokerV.Results, Dest); 170 170 end; 171 171 … … 203 203 begin 204 204 CallV('ORWDFH CURRENT MEALS', [Patient.DFN, MealType]); 205 Dest.Assign(RPCBrokerV.Results);205 FastAssign(RPCBrokerV.Results, Dest); 206 206 MixedCaseList(Dest); 207 207 end; -
cprs/trunk/CPRS-Chart/Orders/rODLab.pas
r456 r829 23 23 function GetLastCollectionTime: string; 24 24 procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer); 25 procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string); 26 procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer); 25 27 procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList); 26 28 procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList); 27 29 function StatAllowed(PatientID: string): boolean; 28 30 procedure GetBloodComponents(Dest: TStrings); 31 function NursAdminSuppress: boolean; 32 function GetSubtype(TestName: string): string; 33 function TNSDaysBack: integer; 34 procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string); 35 procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList); 36 function GetLCtoWCInstructions(Alocation: integer): string; 37 procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings); 38 procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings); 39 40 const 41 TX0 = 'The following Lab orders will be changed to Ward Collect:'; 42 TX2 = 'Order Date' + #9 +#9 + 'Reason Changed to Ward Collect'; 43 TX5 = 'Please contact the ward staff to insure the specimen is collected.'; 44 TX6 = 'You can print this screen for reference.'; 45 TX_BLANK = ''; 29 46 30 47 implementation 31 48 32 49 uses rODBase; 33 (* fODBase, rODBase, fODLab;*)34 50 35 51 procedure GetBloodComponents(Dest: TStrings); … … 38 54 end; 39 55 56 function NursAdminSuppress: boolean; 57 begin 58 Result := (StrToInt(sCallV('ORWDXVB NURSADMN',[nil])) < 1); 59 end; 60 40 61 function StatAllowed(PatientID: string): boolean; 41 62 begin … … 56 77 begin 57 78 tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]); 79 end; 80 81 function GetSubtype(TestName: string): string; 82 begin 83 Result := sCallV('ORWDXVB SUBCHK', [TestName]); 84 end; 85 86 function TNSDaysBack: integer; 87 begin 88 Result := StrToIntDef(sCallV('ORWDXVB VBTNS', [nil]),3); 89 end; 90 91 procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string); 92 begin 93 CallV('ORWUL QV4DG', [DGrpNm]); 94 AListIEN := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 1), 0); 95 ACount := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0); 96 end; 97 98 procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer); 99 var 100 i: Integer; 101 begin 102 CallV('ORWUL QVSUB', [AListIEN,'','']); 103 for i := 0 to RPCBrokerV.Results.Count -1 do 104 Dest.Add(RPCBrokerV.Results[i]); 58 105 end; 59 106 … … 158 205 end; 159 206 207 procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string); 208 var 209 AList: TStringList; 210 begin 211 AList := TStringList.Create; 212 try 213 CallV('ORCDLR2 CHECK ONE LC TO WC', [ALocation, '', AStartDate, ACollType, ASchedule, ADuration]); 214 FastAssign(RPCBrokerV.Results, AList); 215 FormatLCtoWCDisplayTextOnAccept(AList, Dest); 216 finally 217 AList.Free; 218 end; 219 end; 220 221 procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList); 222 var 223 AList: TStringList; 224 begin 225 AList := TStringList.Create; 226 try 227 CallV('ORCDLR2 CHECK ALL LC TO WC', [ALocation, OrderList]); 228 FastAssign(RPCBrokerV.Results, AList); 229 FormatLCtoWCDisplayTextOnRelease(AList, Dest); 230 finally 231 AList.Free; 232 end; 233 end; 234 235 procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings); 236 var 237 i: integer; 238 x: string; 239 begin 240 OutputList.Clear; 241 for i := InputList.Count - 1 downto 0 do 242 if Piece(InputList[i], U, 2) = '1' then InputList.Delete(i); 243 if InputList.Count > 0 then 244 begin 245 SetListFMDateTime('mmm dd, yyyy@hh:nn', TStringList(InputList), U, 1); 246 with OutputList do 247 begin 248 Add(TX0); 249 Add(TX_BLANK); 250 Add('Patient :' + #9 + Patient.Name); 251 Add('SSN :' + #9 + Patient.SSN); 252 Add('Location:' + #9 + Encounter.LocationName + CRLF); 253 for i := 0 to InputList.Count - 1 do 254 Add(Piece(InputList[i], U, 1) + #9 + Piece(InputList[i], U, 3)); 255 Add(TX_BLANK); 256 x := GetLCtoWCInstructions(Encounter.Location); 257 if x = '' then x := TX5; 258 Add(x); 259 Add(TX6); 260 end; 261 end; 262 end; 263 264 procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings); 265 var 266 i, j, k, Changed: integer; 267 AList: TStringlist; 268 x: string; 269 begin 270 OutputList.Clear; 271 Changed := StrToIntDef(ExtractDefault(InputList, 'COUNT'), 0); 272 if Changed > 0 then 273 begin 274 AList := TStringList.Create; 275 try 276 with OutputList do 277 begin 278 Add(TX0); 279 Add(TX_BLANK); 280 Add('Patient :' + #9 + Patient.Name); 281 Add('SSN :' + #9 + Patient.SSN); 282 Add('Location:' + #9 + Encounter.LocationName); 283 for i := 1 to Changed do 284 begin 285 Add(TX_BLANK); 286 AList.Clear; 287 ExtractText(AList, InputList, 'ORDER_' + IntToStr(i)); 288 Add('Order :' + #9 + AList[0]); 289 k := Length(OutputList[Count-1]); 290 if AList.Count > 1 then 291 for j := 1 to AList.Count - 1 do 292 begin 293 Add(StringOfChar(' ', 9) + #9 + AList[j]); 294 k := HigherOf(k, Length(OutputList[Count - 1])); 295 end; 296 Add(StringOfChar('-', k + 4)); 297 AList.Clear; 298 ExtractItems(AList, InputList, 'ORDER_' + IntToStr(i)); 299 SetListFMDateTime('mmm dd, yyyy@hh:nn', AList, U, 1); 300 for j := 0 to AList.Count - 1 do 301 OutputList.Add(Piece(AList[j], U, 1) + #9 + Piece(AList[j], U, 3)); 302 end; 303 Add(TX_BLANK); 304 x := GetLCtoWCInstructions(Encounter.Location); 305 if x = '' then x := TX5; 306 Add(x); 307 Add(TX6); 308 end; 309 finally 310 AList.Free; 311 end; 312 end; 313 end; 314 315 function GetLCtoWCInstructions(Alocation: integer): string; 316 begin 317 Result := sCallV('ORWDLR33 LC TO WC', [Encounter.Location]); 318 end; 319 160 320 end. 321 322 -
cprs/trunk/CPRS-Chart/Orders/rODMeds.pas
r456 r829 3 3 interface 4 4 5 uses SysUtils, Classes, ORNet, ORFn, uCore, uConst; 5 uses SysUtils, Classes, ORNet, ORFn, uCore, uConst, Windows; 6 7 type 8 TAdminTimeHelpText = record 9 HelpText: string; 10 end; 11 12 TInpatientClozapineText = record 13 dispText: string; 14 end; 15 16 TDrugHasMaxData = record 17 CaptureMaxData: boolean; 18 MaxSupply: integer; 19 MaxQuantity: integer; 20 MaxRefills: integer; 21 end; 6 22 7 23 function DEACheckFailed(AnOI: Integer; ForInpatient: Boolean): Boolean; … … 17 33 procedure LoadFormularyAltDose(AList: TStringList; DispDrug, OI: Integer; ForInpatient: Boolean); 18 34 procedure LoadAdminInfo(const Schedule: string; OrdItem: Integer; var StartText: string; 19 var AdminTime: TFMDateTime; var Duration: string );35 var AdminTime: TFMDateTime; var Duration: string; Admin: string = ''); 20 36 function GetAdminTime(const StartText, Schedule: string; OrdItem: Integer): TFMDateTime; 21 37 procedure LoadSchedules(Dest: TStrings; IsInptDlg: boolean = False); 38 procedure LoadDOWSchedules(Dest: TStrings); 39 procedure LoadAllIVRoutes(Dest: TStrings); 40 procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList; Default: boolean); 22 41 function QtyToDays(Quantity: Double; const UnitsPerDose, Schedule, Duration, Drug: string): Integer; 23 42 function DaysToQty(DaysSupply: Integer; const UnitsPerDose, Schedule, Duration, Drug: string): Integer; … … 32 51 function QOHasRouteDefined(AQOID: integer): boolean; 33 52 procedure CheckExistingPI(AOrderId: string; var APtI: string); 53 function PassDrugTest(OI: integer; OrderType: string; InptOrder: boolean; CheckForClozapineOnly: boolean = false): boolean; 54 function AdminTimeHelpText(): string; 55 //function ValidateDaySupplyandQuantity(DaySupply, Quantity: integer): boolean; 56 //function ValidateMaxQuantity(Quantity: integer): boolean; 57 function ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur: string; OI, tempSupply, tempQuantity, tempRefills: integer): boolean; 58 function ValidateDaySupplyandQuantityErrorMsg(DaySupply, quantity: integer): String; 59 procedure ClearMaxData; 60 function DifferentOrderLocations(ID: string; Loc: integer): boolean; 61 function IsClozapineOrder: boolean; 62 //function ValidateQuantityErrorMsg(Quantity: integer): String; 63 function GetQOOrderableItem(DialogIEN: string): integer; 64 34 65 35 66 implementation 67 var 68 uAdminTimeHelpText: TAdminTimeHelpText; 69 uDrugHasMaxData: TDrugHasMaxData; 70 uInpatientClozapineText : TInpatientClozapineText; 36 71 37 72 function DEACheckFailed(AnOI: Integer; ForInpatient: Boolean): Boolean; … … 60 95 begin 61 96 CallV('ORWUL FVSUB', [ListIEN, First+1, Last+1]); // M side not 0-based 62 if Append then Dest.AddStrings(RPCBrokerV.Results) else97 if Append then FastAddStrings(RPCBrokerV.Results, Dest) else 63 98 begin 64 99 for i := Pred(RPCBrokerV.Results.Count) downto 0 do Dest.Insert(0, RPCBrokerV.Results[i]); … … 123 158 if ForInpatient then PtType := 'I' else PtType := 'O'; 124 159 CallV('ORWDPS1 FORMALT', [AnIEN, PtType]); 125 AList.Assign(RPCBrokerV.Results);160 FastAssign(RPCBrokerV.Results, AList); 126 161 end; 127 162 … … 132 167 if ForInpatient then PtType := 'I' else PtType := 'O'; 133 168 CallV('ORWDPS1 DOSEALT', [DispDrug, OI, PtType]); 134 AList.Assign(RPCBrokerV.Results);169 FastAssign(RPCBrokerV.Results, AList); 135 170 end; 136 171 137 172 procedure LoadAdminInfo(const Schedule: string; OrdItem: Integer; var StartText: string; 138 var AdminTime: TFMDateTime; var Duration: string );173 var AdminTime: TFMDateTime; var Duration: string; Admin: string = ''); 139 174 var 140 175 x: string; 141 176 begin 142 x := sCallV('ORWDPS2 ADMIN', [Patient.DFN, Schedule, OrdItem, Encounter.Location ]);177 x := sCallV('ORWDPS2 ADMIN', [Patient.DFN, Schedule, OrdItem, Encounter.Location, Admin]); 143 178 StartText := Piece(x, U, 1); 144 179 AdminTime := MakeFMDateTime(Piece(x, U, 4)); … … 157 192 begin 158 193 // if uMedSchedules = nil then CallV('ORWDPS ALLSCHD', [nil]); uMedSchedules.Assign(...); 159 CallV('ORWDPS1 SCHALL', [ nil]);160 Dest.Assign(RPCBrokerV.Results);194 CallV('ORWDPS1 SCHALL', [patient.dfn, patient.location]); 195 FastAssign(RPCBrokerV.Results, Dest); 161 196 If (Dest.IndexOfName('OTHER') < 0) and IsInptDlg then 162 197 Dest.Add('OTHER'); 163 198 end; 164 199 200 procedure LoadAllIVRoutes(Dest: TStrings); 201 begin 202 CallV('ORWDPS32 ALLIVRTE', []); 203 FastAssign(RPCBrokerV.Results, Dest); 204 end; 205 206 procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList; Default: boolean); 207 begin 208 CallV('ORWDPS33 IVDOSFRM', [OrderIDs, Default, False]); 209 FastAssign(RPCBrokerV.Results, Dest); 210 end; 211 procedure LoadDOWSchedules(Dest: TStrings); 212 begin 213 // if uMedSchedules = nil then CallV('ORWDPS ALLSCHD', [nil]); uMedSchedules.Assign(...); 214 CallV('ORWDPS1 DOWSCH', [patient.dfn, patient.location]); 215 FastAssign(RPCBrokerV.Results, Dest); 216 end; 217 165 218 function QtyToDays(Quantity: Double; const UnitsPerDose, Schedule, Duration, Drug: string): Integer; 166 219 begin … … 173 226 Result := StrToIntDef(sCallV('ORWDPS2 DAY2QTY', 174 227 [DaysSupply, UnitsPerDose, Schedule, Duration, Patient.DFN, Drug]), 0); 228 if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxQuantity := Result; 175 229 end; 176 230 … … 183 237 begin 184 238 Result := StrToIntDef(sCallV('ORWDPS1 DFLTSPLY', [UnitStr, SchedStr, Patient.DFN, ADrug]), 0); 239 if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxSupply := Result; 185 240 end; 186 241 … … 188 243 begin 189 244 Result := StrToIntDef(sCallV('ORWDPS2 MAXREF', [Patient.DFN, Drug, Days, OrdItem, Discharge]), 0); 245 if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxRefills := Result; 190 246 end; 191 247 … … 239 295 end; 240 296 297 function PassDrugTest(OI: integer; OrderType: string; InptOrder: boolean; CheckForClozapineOnly: boolean = false): boolean; 298 var 299 MessCap, MessText: string; 300 i: integer; 301 begin 302 result := false; 303 MessText := ''; 304 uDrugHasMaxData.CaptureMaxData := false; 305 uDrugHasMaxData.MaxSupply := 0; 306 uDrugHasMaxData.MaxQuantity := 0; 307 uDrugHasMaxData.MaxRefills := 0; 308 CallV('ORALWORD ALLWORD', [Patient.DFN, OI, OrderType, Encounter.Provider]); 309 for i := 0 to RPCBrokerV.Results.Count -1 do 310 begin 311 if i = 0 then 312 begin 313 MessCap := Piece(RPCBrokerV.Results.strings[i],U,1); 314 if Piece(RPCBrokerV.Results.strings[i],U,2) = '1' then uDrugHasMaxData.CaptureMaxData := True; 315 end; 316 if i >0 then MessText := MessText + RPCBrokerV.Results.Strings[i] + CRLF; 317 end; 318 if CheckForClozapineOnly = True then 319 begin 320 Result := uDrugHasMaxData.CaptureMaxData = True; 321 Exit; 322 end; 323 if (MessText = '') and (MessCap = '') then 324 begin 325 Result := True; 326 if (InptOrder = true) and (uDrugHasMaxData.CaptureMaxData = true) then 327 begin 328 uDrugHasMaxData.CaptureMaxData := false; 329 if uInpatientClozapineText.dispText = '' then 330 begin 331 CallV('ORDDPAPI CLOZMSG', []); 332 for i := 0 to RPCBrokerV.Results.Count -1 do 333 if i = 0 then uInpatientClozapineText.dispText := RPCBrokerV.Results.Strings[i] 334 else uInpatientClozapineText.dispText := uInpatientClozapineText.dispText + CRLF + RPCBrokerV.Results.Strings[i]; 335 end; 336 if uInpatientClozapineText.dispText <> '' then infoBox(uInpatientClozapineText.dispText, 'Inpatient Drug Warning', MB_OK); 337 end; 338 exit; 339 end; 340 infoBox(MessText, MessCap,MB_OK); 341 end; 342 343 function AdminTimeHelpText(): string; 344 var 345 i: integer; 346 begin 347 if uAdminTimeHelpText.HelpText = '' then 348 begin 349 CallV('ORDDPAPI ADMTIME',[]); 350 for I := 0 to RPCBrokerV.Results.Count - 1 do 351 if I = 0 then uAdminTimeHelpText.HelpText := RPCBrokerV.Results.Strings[i] 352 else uAdminTimeHelpText.HelpText := uAdminTimeHelpText.HelpText + CRLF +RPCBrokerV.Results.Strings[i]; 353 end; 354 Result := uAdminTimeHelpText.helpText 355 end; 356 357 function ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur: string; OI, tempSupply, tempQuantity, tempRefills: integer): boolean; 358 var 359 daySupply, Quantity, Refills: integer; 360 begin 361 Result := True; 362 if uDrugHasMaxData.CaptureMaxData = false then exit; 363 daySupply := DefaultDays(tempDrug, tempUnit, tempSch); 364 if (tempSupply > daySupply) and (uDrugHasMaxData.MaxSupply > 0) then 365 begin 366 infoBox('For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply), 'Cannot Save Error', MB_OK); 367 Result := false; 368 uDrugHasMaxData.CaptureMaxData := false; 369 Exit; 370 end; 371 Quantity := DaysToQty(daySupply, tempUnit, tempSch, tempDur, tempDrug); 372 if (tempQuantity > Quantity) and (uDrugHasMaxData.MaxQuantity > 0) then 373 begin 374 infoBox('For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity), 'Cannot Save Error', MB_OK); 375 Result := false; 376 uDrugHasMaxData.CaptureMaxData := false; 377 Exit; 378 end; 379 Refills := CalcMaxRefills(tempDrug, daySupply, OI, false); 380 if tempRefills > Refills then 381 begin 382 infoBox('For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxRefills), 'Cannot Save Error', MB_OK); 383 Result := false; 384 uDrugHasMaxData.CaptureMaxData := false; 385 Exit; 386 end; 387 end; 388 389 function ValidateDaySupplyandQuantity(DaySupply, Quantity: integer): boolean; 390 var 391 str: string; 392 begin 393 Result := True; 394 str := ''; 395 if uDrugHasMaxData.CaptureMaxData = false then exit; 396 if (daySupply > uDrugHasMaxData.MaxSupply) and (uDrugHasMaxData.MaxSupply > 0) then 397 begin 398 str := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply); 399 Result := false; 400 end; 401 if (Quantity > uDrugHasMaxData.MaxQuantity) and (uDrugHasMaxData.MaxQuantity > 0) then 402 begin 403 if str <> '' then str := str + CRLF + 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity) 404 else str := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity); 405 result := false; 406 end; 407 if str <> '' then infoBox(str, 'Cannot Save Error', MB_OK); 408 //uDrugHasMaxData.CaptureMaxData := false; 409 end; 410 411 function ValidateMaxQuantity(Quantity: integer): boolean; 412 begin 413 Result := True; 414 if uDrugHasMaxData.CaptureMaxData = false then exit; 415 if uDrugHasMaxData.MaxQuantity = 0 then exit; 416 if Quantity > uDrugHasMaxData.MaxQuantity then 417 begin 418 infoBox('For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity), 'Cannot Save Error', MB_OK); 419 Result := false; 420 end; 421 end; 422 423 function ValidateDaySupplyandQuantityErrorMsg(DaySupply, quantity: integer): String; 424 begin 425 Result := ''; 426 if uDrugHasMaxData.CaptureMaxData = false then exit; 427 if (daySupply > uDrugHasMaxData.MaxSupply) and (uDrugHasMaxData.MaxSupply > 0) then 428 begin 429 Result := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply); 430 end; 431 if (Quantity > uDrugHasMaxData.MaxQuantity) and (uDrugHasMaxData.MaxQuantity > 0) then 432 begin 433 if Result <> '' then Result := Result + CRLF + 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity) 434 else Result := 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity); 435 end; 436 //uDrugHasMaxData.CaptureMaxData := false; 437 end; 438 439 function ValidateQuantityErrorMsg(Quantity: integer): String; 440 begin 441 Result := ''; 442 if uDrugHasMaxData.CaptureMaxData = false then exit; 443 if uDrugHasMaxData.MaxQuantity = 0 then exit; 444 if Quantity > uDrugHasMaxData.MaxQuantity then 445 begin 446 Result := 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity); 447 end; 448 end; 449 450 procedure ClearMaxData; 451 begin 452 uDrugHasMaxData.CaptureMaxData := false; 453 end; 454 455 function DifferentOrderLocations(ID: string; Loc: integer): boolean; 456 begin 457 Result := (sCallV('ORWDPS33 COMPLOC', [ID, Loc])='1'); 458 end; 459 460 function IsClozapineOrder: boolean; 461 begin 462 if uDrugHasMaxData.CaptureMaxData = true then result := true 463 else result := false; 464 end; 465 466 function GetQOOrderableItem(DialogIEN: string): integer; 467 begin 468 Result := StrtoInt(SCallV('ORWDPS1 QOMEDALT',[DialogIEN])) 469 end; 470 241 471 end. -
cprs/trunk/CPRS-Chart/Orders/rODRad.pas
r456 r829 13 13 function SubsetOfImagingTypes: TStrings; 14 14 function SubsetOfRadSources(SrcType: string): TStrings; 15 function LocationType(Location: integer): string; 15 function LocationType(Location: integer): string; 16 function ReasonForStudyCarryOn: Boolean; 16 17 17 18 implementation … … 73 74 begin 74 75 Result := sCallV('ORWDRA32 LOCTYPE',[Location]); 76 end; 77 78 function ReasonForStudyCarryOn: Boolean; 79 begin 80 Result := sCallV('ORWDXM1 SVRPC',['']) = '1'; 75 81 end; 76 82 -
cprs/trunk/CPRS-Chart/Orders/rOrders.pas
r456 r829 39 39 LinkObject: TObject; 40 40 EnteredInError: Integer; //AGP Changes 26.12 PSI-04-053 41 DCOriginalOrder: boolean; 41 42 procedure Assign(Source: TOrder); 42 43 procedure Clear; … … 200 201 procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string); 201 202 procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string); 202 procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string ); {*KCM*}203 procedure PrintServiceCopies(OrderList: TStringList ); {*REV*}204 procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char ); {*KCM*}203 procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0); {*KCM*} 204 procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0); {*REV*} 205 procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0); {*KCM*} 205 206 function UseNewMedDialogs: Boolean; 206 207 … … 221 222 procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer); 222 223 function GetREQReason: Integer; 223 procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);224 procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer); 224 225 procedure ReleaseOrderHold(AnOrder: TOrder); 225 226 procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64); … … 238 239 function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean; 239 240 procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer); 241 function DoesOrderStatusMatch(OrderArray: TStringList): boolean; 240 242 //function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams; 241 243 … … 340 342 implementation 341 343 342 uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore ;344 uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore, VAUtils; 343 345 344 346 var … … 576 578 577 579 procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string); 578 { 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 579 { Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig }580 { 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 581 { Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig^IMO^DCOrigOrder} 580 582 begin 581 583 with AnOrder do … … 600 602 Retrieved := True; 601 603 OrderLocIEN := Piece(Piece(x,U,19),':',2); //imo 602 OrderLocName := Piece(Piece(x,U,19),':',1); //imo 604 if Piece(Piece(x,U,19),':',1) = '0;SC(' then OrderLocName := 'Unknown' 605 else OrderLocName := Piece(Piece(x,U,19),':',1); //imo 603 606 Text := y; 604 607 XMLText := z; … … 609 612 else AnOrder.EnteredInError := 0; 610 613 //if DGroupName = 'Non-VA Meds' then Text := 'Non-VA ' + Text; 614 if Piece(x,U,20) = '1' then DCOriginalOrder := True 615 else DCOriginalOrder := False; 611 616 end; 612 617 end; … … 655 660 AnOrder: TOrder; 656 661 FilterTS: string; 662 AlertedUserOnly: boolean; 657 663 begin 658 664 ClearOrders(Dest); 659 665 if uDGroupMap = nil then LoadDGroupMap; // to make sure broker not called while looping thru Results 660 666 FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty); 661 CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID]); 667 AlertedUserOnly := (Notifications.Active and (AView.Filter = 12)); 668 CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID, AlertedUserOnly]); 662 669 if ((Piece(RPCBrokerV.Results[0], U, 1) = '0') or (Piece(RPCBrokerV.Results[0], U, 1) = '')) and (AView.Filter = 5) then // if no expiring orders found display expired orders) 663 670 begin … … 756 763 CallV('ORWOR SHEETS', [Patient.DFN]); 757 764 MixedCaseByPiece(RPCBrokerV.Results, U, 2); 758 Dest.Assign(RPCBrokerV.Results);759 end;765 FastAssign(RPCBrokerV.Results, Dest); 766 end; 760 767 761 768 procedure LoadOrderSheetsED(Dest: TStrings); … … 771 778 for i := 0 to RPCbrokerV.Results.Count - 1 do 772 779 RPCBrokerV.Results[i] := RPCBrokerV.Results[i] + ' Orders'; 773 Dest.AddStrings(RPCBrokerV.Results);780 FastAddStrings(RPCBrokerV.Results, Dest); 774 781 end; 775 782 end; … … 812 819 for i := 0 to Pred(HaveList.Count) do Param[1].Mult['"' + HaveList[i] + '"'] := ''; 813 820 CallBroker; 814 IDList.Assign(Results);821 FastAssign(RPCBrokerV.Results,IDList); 815 822 end; 816 823 end; … … 1015 1022 begin 1016 1023 CallV('ORWORDG ALLTREE', [nil]); 1017 Dest.Assign(RPCBrokerV.Results);1024 FastAssign(RPCBrokerV.Results, Dest); 1018 1025 end; 1019 1026 … … 1022 1029 CallV('ORWOR TSALL', [nil]); 1023 1030 MixedCaseList(RPCBrokerV.Results); 1024 Dest.Assign(RPCBrokerV.Results);1031 FastAssign(RPCBrokerV.Results, Dest); 1025 1032 end; 1026 1033 … … 1032 1039 otherEvts: TStringList; 1033 1040 commonList: TStringList; 1041 IsObservation: boolean; 1034 1042 begin 1035 1043 if Encounter <> nil then … … 1037 1045 else 1038 1046 Currloc := 0; 1047 IsObservation := (Piece(GetCurrentSpec(Patient.DFN), U, 3) = '1'); 1039 1048 commonList := TStringList.Create; 1040 1049 CallV('OREVNTX1 CMEVTS',[Currloc]); … … 1053 1062 commonList.Add(Results[i]); 1054 1063 end 1064 else if IsObservation then 1065 begin 1066 if (Piece(Results[i],'^',3) = 'T') then 1067 Continue; 1068 commonList.Add(Results[i]); 1069 end 1055 1070 else 1056 1071 begin … … 1061 1076 if commonList.Count > 0 then 1062 1077 begin 1063 Dest.AddStrings(TStrings(commonList));1078 FastAddStrings(TStrings(commonList), Dest); 1064 1079 Dest.Add('^^^^^^^^___________________________________________________________________________________________'); 1065 1080 Dest.Add(LLS_SPACE); … … 1074 1089 begin 1075 1090 RPCBrokerV.Results.Delete(0); 1076 admitEvts.AddStrings(RPCBrokerV.Results);1091 FastAddStrings(RPCBrokerV.Results, admitEvts); 1077 1092 end; 1078 CallV('OREVNTX ACTIVE',['T^O^M^D']); 1093 if IsObservation then 1094 CallV('OREVNTX ACTIVE',['O^M^D']) 1095 else 1096 CallV('OREVNTX ACTIVE',['T^O^M^D']); 1079 1097 //MixedCaseList(RPCBrokerV.Results); 1080 1098 if RPCBrokerV.Results.Count > 0 then 1081 1099 begin 1082 1100 RPCBrokerV.Results.Delete(0); 1083 otherEvts.AddStrings(RPCBrokerV.Results);1101 FastAddStrings(RPCBrokerV.Results, otherEvts); 1084 1102 end; 1085 Dest.AddStrings(TStrings(otherEvts));1103 FastAddStrings(TStrings(otherEvts), Dest); 1086 1104 Dest.Add('^^^^^^^^_____________________________________________________________________________________________'); 1087 1105 Dest.Add(LLS_SPACE); 1088 Dest.AddStrings(TStrings(admitEvts));1106 FastAddStrings(TStrings(admitEvts), Dest); 1089 1107 admitEvts.Free; 1090 1108 otherEvts.Free; … … 1096 1114 if RPCBrokerV.Results.Count > 0 then 1097 1115 RPCBrokerV.Results.Delete(0); 1098 Dest.AddStrings(RPCBrokerV.Results);1116 FastAddStrings(RPCBrokerV.Results, Dest); 1099 1117 end 1100 1118 else … … 1104 1122 if RPCBrokerV.Results.Count > 0 then 1105 1123 RPCBrokerV.Results.Delete(0); 1106 Dest.AddStrings(RPCBrokerV.Results);1124 FastAddStrings(RPCBrokerV.Results, Dest); 1107 1125 end; 1108 1126 end; … … 1111 1129 begin 1112 1130 CallV('ORWORDG REVSTS', [nil]); 1113 Dest.Assign(RPCBrokerV.Results);1131 FastAssign(RPCBrokerV.Results, Dest); 1114 1132 end; 1115 1133 … … 1118 1136 begin 1119 1137 CallV('ORWORDG REVSTS', [nil]); 1120 Dest.Assign(RPCBrokerV.Results);1138 FastAssign(RPCBrokerV.Results, Dest); 1121 1139 end; 1122 1140 … … 1172 1190 RESERVED_PIECE + U + // 10 1173 1191 KeyVars; 1174 CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses ]);1192 CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses, Encounter.Location]); 1175 1193 // LST(0)=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp 1176 1194 with RPCBrokerV do … … 1275 1293 RPCBrokerV.Results.Delete(0); 1276 1294 end; 1277 SetItems.Assign(RPCBrokerV.Results);1295 FastAssign(RPCBrokerV.Results, SetItems); 1278 1296 end; 1279 1297 … … 1281 1299 begin 1282 1300 CallV('ORWDX WRLST', [Encounter.Location]); 1283 Dest.Assign(RPCBrokerV.Results);1301 FastAssign(RPCBrokerV.Results, Dest); 1284 1302 end; 1285 1303 … … 1290 1308 begin 1291 1309 Dest.Clear; 1292 Dest.Assign(RPCBrokerV.Results);1310 FastAssign(RPCBrokerV.Results, Dest); 1293 1311 end 1294 1312 end; … … 1310 1328 then Results[i] := Piece(Results[i], U, 1); 1311 1329 OrderList.Clear; 1312 OrderList.Assign(RPCBrokerV.Results);1330 FastAssign(RPCBrokerV.Results, OrderList); 1313 1331 end; 1314 1332 … … 1324 1342 CallV('ORWDX SENDED',[OrderList,CurrTS,Loc]); 1325 1343 OrderList.Clear; 1326 OrderList.Assign(RPCBrokerV.Results);1344 FastAssign(RPCBrokerV.Results, OrderList); 1327 1345 end; 1328 1346 … … 1339 1357 end; 1340 1358 1341 procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string); 1342 begin 1343 CallV('ORWD1 RVPRINT', [Encounter.Location, DeviceInfo, OrderList]); 1344 end; 1345 1346 procedure PrintServiceCopies(OrderList: TStringList); {*REV*} 1347 begin 1348 CallV('ORWD1 SVONLY', [Encounter.Location, OrderList]); 1359 procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0); 1360 var 1361 Loc: Integer; 1362 begin 1363 if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc 1364 else Loc := Encounter.Location; 1365 CallV('ORWD1 RVPRINT', [Loc, DeviceInfo, OrderList]); 1366 end; 1367 1368 procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0); {*REV*} 1369 var 1370 Loc: Integer; 1371 begin 1372 if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc 1373 else Loc := Encounter.Location; 1374 CallV('ORWD1 SVONLY', [Loc, OrderList]); 1349 1375 end; 1350 1376 … … 1432 1458 CallV('ORWOR ACTION TEXT',[ID]); 1433 1459 if RPCBrokerV.Results.Count > 0 then 1434 Errlist.Assign(RPCBrokerV.Results);1460 FastAssign(RPCBrokerV.Results, Errlist); 1435 1461 end; 1436 1462 … … 1515 1541 procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer); 1516 1542 begin 1517 CallV('ORWDX ADCREASON', [nil]);1543 CallV('ORWDX2 DCREASON', [nil]); 1518 1544 ExtractItems(Dest, RPCBrokerV.Results, 'DCReason'); 1519 1545 //AGP Change 26.15 for PSI-04-63 … … 1526 1552 end; 1527 1553 1528 procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);1529 var 1530 AParentID 1554 procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer); 1555 var 1556 AParentID, DCOrigOrder: string; 1531 1557 begin 1532 1558 AParentID := AnOrder.ParentID; 1533 CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason]); 1559 if AnOrder.DCOriginalOrder = true then DCOrigOrder := '1' 1560 else DCOrigOrder := '0'; 1561 CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason, DCOrigOrder, NewOrder]); 1534 1562 UBACore.DeleteDCOrdersFromCopiedList(AnOrder.ID); 1535 1563 DCType := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 14), 0); … … 1553 1581 begin 1554 1582 CallV('ORWDXA FLAGTXT', [ID]); 1555 Dest.Assign(RPCBrokerV.Results);1583 FastAssign(RPCBrokerV.Results, Dest); 1556 1584 end; 1557 1585 … … 1565 1593 begin 1566 1594 CallV('ORWDXA WCGET', [ID]); 1567 Dest.Assign(RPCBrokerV.Results);1595 FastAssign(RPCBrokerV.Results, Dest); 1568 1596 end; 1569 1597 … … 1614 1642 if piece(Results[0],'^',1) = '-1' then 1615 1643 begin 1616 ShowM essage('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF +1644 ShowMsg('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF + 1617 1645 'This error will prevent this order from being sent to the service for processing. Please cancel the order and try again.' + CRLF + CRLF + 1618 1646 'If this problem persists, then there is a problem in the CPRS PKI interface, and it needs to be reported through the proper channels, to the developer Cary Malmrose.'); … … 1651 1679 SCallV('ORWDXR01 SAVCHG',[AnID,TheRefills,ThePickup,IsTxtOrder]); 1652 1680 SetOrderFromResults(AnOrder); 1681 end; 1682 1683 function DoesOrderStatusMatch(OrderArray: TStringList): boolean; 1684 begin 1685 Result := StrtoIntDef(SCallV('ORWDX1 ORDMATCH',[Patient.DFN, OrderArray]),0)=1; 1653 1686 end; 1654 1687 … … 1698 1731 CallV('ORWDPS5 LESAPI',[AnOrderInfo]); 1699 1732 if RPCBrokerV.Results.Count > 0 then 1700 RejectedReason.Assign(RPCBrokerV.Results);1733 FastAssign(RPCBrokerV.Results, RejectedReason); 1701 1734 end; 1702 1735 … … 2076 2109 MixedCaseList( RPCBrokerV.Results ); 2077 2110 RPCBrokerV.Results.Delete(0); 2078 Dest.Assign(RPCBrokerV.Results);2111 FastAssign(RPCBrokerV.Results, Dest); 2079 2112 end; 2080 2113 end; … … 2087 2120 begin 2088 2121 SortByPiece(TStringList(RPCBrokerV.Results),'^',2); 2089 Dest.Assign(RPCBrokerV.Results);2122 FastAssign(RPCBrokerV.Results, Dest); 2090 2123 end; 2091 2124 end; … … 2188 2221 then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN]) 2189 2222 else CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]); 2190 ListOfChecks.Assign(RPCBrokerV.Results);2223 FastAssign(RPCBrokerV.Results, ListOfChecks); 2191 2224 end; 2192 2225 … … 2198 2231 then CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList]) 2199 2232 else CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]); 2200 ListOfChecks.Assign(RPCBrokerV.Results);2233 FastAssign(RPCBrokerV.Results, ListOfChecks); 2201 2234 end; 2202 2235 … … 2204 2237 begin 2205 2238 CallV('ORWDXC SESSION', [Patient.DFN, OrderList]); 2206 ListOfChecks.Assign(RPCBrokerV.Results);2239 FastAssign(RPCBrokerV.Results, ListOfChecks); 2207 2240 end; 2208 2241 … … 2253 2286 (PromptForWorkCopy in ['1','2'])); 2254 2287 RPCBrokerV.Results.Delete(0); 2255 OrdersToPrint.Assign(RPCBrokerV.Results);2288 FastAssign(RPCBrokerV.Results, OrdersToPrint); 2256 2289 end; 2257 2290 Result := TempParams; … … 2262 2295 *) 2263 2296 2264 procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char );2297 procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0); 2265 2298 var 2266 2299 x: string; 2267 2300 begin 2268 2301 if Nature <> #0 then 2269 CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList]) 2302 begin 2303 if PrintLoc > 0 then CallV('ORWD2 DEVINFO', [PrintLoc, Nature, OrderList]) 2304 else CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList]); 2305 end 2270 2306 else 2271 CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]); 2307 begin 2308 if PrintLoc > 0 then CallV('ORWD2 MANUAL', [PrintLoc, OrderList]) 2309 else CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]); 2310 end; 2272 2311 x := RPCBrokerV.Results[0]; 2273 2312 FillChar(PrintParams, SizeOf(PrintParams), #0); … … 2295 2334 RPCBrokerV.Results.Delete(0); 2296 2335 OrderList.Clear; 2297 OrderList.Assign(RPCBrokerV.Results);2336 FastAssign(RPCBrokerV.Results, OrderList); 2298 2337 end; 2299 2338 end; -
cprs/trunk/CPRS-Chart/Orders/uODBase.pas
r456 r829 23 23 procedure PushKeyVars(const NewVals: string); 24 24 procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = ''); 25 procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string; 26 var CancelText: string; Sender: TObject); 25 27 26 28 implementation 27 29 28 30 uses 29 dShared, Windows, rTemplates ;31 dShared, Windows, rTemplates, SysUtils, StdCtrls, fOrders, rOrders; 30 32 31 33 var … … 190 192 end; 191 193 194 // Check for diet orders that will be auto-DCd on release because of start/stop overlaps. 195 // Moved here for visibility because it also needs to be checked on an auto-accept order. 196 procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string; 197 var CancelText: string; Sender: TObject); 198 const 199 TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF + 200 'you specify a start date for when the new diet should replace the current' + CRLF + 201 'diet:' + CRLF + CRLF; 202 TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF; 203 TX_CX_DELAYED1 = 'There are other delayed diet orders for this release event:'; 204 TX_CX_DELAYED2 = 'This new diet order may cancel and replace those other diets' + CRLF + 205 'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF + 206 207 '1. Specify an expiration date/time for this order that will' + CRLF + 208 ' be prior to the start date/time of those other orders; or' + CRLF + CRLF + 209 210 '2. Specify a later start date/time for this order for when you' + CRLF + 211 ' would like it to cancel and replace those other orders.'; 212 213 var 214 i: integer; 215 AStringList: TStringList; 216 AList: TList; 217 x, PtEvtIFN, PtEvtName: string; 218 //AResponse: TResponse; 219 begin 220 if EvtID = 0 then // check current and future released diets 221 begin 222 x := CurrentText; 223 if Piece(x, #13, 1) <> 'Current Diet: ' then 224 begin 225 AStringList := TStringList.Create; 226 try 227 AStringList.Text := x; 228 CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF 229 + #9 + Copy(AStringList[0], 16, 99) + CRLF; 230 if AStringList.Count > 1 then 231 begin 232 CancelText := CancelText + CRLF + CRLF + 233 TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF 234 + #9 + Copy(AStringList[1], 22, 99) + CRLF; 235 if AStringList.Count > 2 then 236 for i := 2 to AStringList.Count - 1 do 237 CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF; 238 end; 239 finally 240 AStringList.Free; 241 end; 242 end; 243 end 244 else if Sender is TButton then // delayed orders code here - on accept only 245 begin 246 //AResponse := Responses.FindResponseByName('STOP', 1); 247 //if (AResponse <> nil) and (AResponse.EValue <> '') then exit; 248 AList := TList.Create; 249 try 250 PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN); 251 PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName; 252 LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN); 253 for i := AList.Count - 1 downto 0 do 254 begin 255 if TOrder(Alist.Items[i]).DGroup <> DispGrp then 256 begin 257 TOrder(AList.Items[i]).Free; 258 AList.Delete(i); 259 end; 260 end; 261 if AList.Count > 0 then 262 begin 263 x := ''; 264 RetrieveOrderFields(AList, 0, 0); 265 CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName; 266 for i := 0 to AList.Count - 1 do 267 with TOrder(AList.Items[i]) do 268 begin 269 x := x + #9 + Text + CRLF; 270 (* if StartTime <> '' then 271 x := #9 + x + 'Start: ' + StartTime + CRLF 272 else 273 x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*) 274 end; 275 CancelText := CancelText + CRLF + CRLF + x; 276 CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2; 277 end; 278 finally 279 with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free; 280 AList.Free; 281 end; 282 end; 283 end; 284 285 192 286 initialization 193 287 uOrderEventType := #0; -
cprs/trunk/CPRS-Chart/Orders/uOrders.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rOrders, ORFn, 7 Dialogs, ORCtrls, stdCtrls, strUtils, fODBase ;7 Dialogs, ORCtrls, stdCtrls, strUtils, fODBase, fODMedOIFA; 8 8 9 9 type 10 10 EOrderDlgFail = class(Exception); 11 12 //FQOAltOI = record 13 //OI: integer; 14 //end; 11 15 12 16 { Ordering Environment } … … 58 62 procedure QuickOrderListEdit; 59 63 function RefNumFor(AnOwner: TComponent): Integer; 60 procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0); 64 procedure PrintOrdersOnSignReleaseMult(OrderList, ClinicLst, WardLst: TStringList; Nature: Char; EncLoc, WardLoc: integer; EncLocName, WardLocName: string); 65 procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = ''); 61 66 procedure SetFontSize( FontSize: integer); 62 67 procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer); 68 //function GetQOAltOI: integer; 63 69 64 70 { Inpatient medication for Outpatient} … … 79 85 ProcDisp : Integer; 80 86 ImgDisp : Integer; 87 DietDisp : Integer; 81 88 NonVADisp: Integer; 82 89 MedsInDlgIen : Integer; … … 92 99 OriginalMedsInHeight: Integer; 93 100 OriginalNonVAMedsHeight: Integer; 101 PassDrugTstCall: boolean; 94 102 95 103 implementation … … 100 108 fLkUpLocation, fOrdersPrint, fOMAction, fARTAllgy, fOMHTML, fOrders, rODBase, 101 109 fODChild, fMeds, rMeds, rPCE, frptBox, fODMedNVA, fODChangeUnreleasedRenew, rODAllergy, 102 UBAGlobals, fClinicWardMeds, uTemplateFields ;110 UBAGlobals, fClinicWardMeds, uTemplateFields, VAUtils; 103 111 104 112 var … … 113 121 uOrderSetTime: TFMDateTime; 114 122 uNewMedDialog: Integer; 123 //QOALTOI: FQOAltOI; 115 124 116 125 const … … 453 462 tmpList.Add('Cannot be released to service(s) because of the following happened action(s):'); 454 463 tmpList.Add(' '); 455 tmpList.AddStrings(TStrings(AnErrLst));464 FastAddStrings(TStrings(AnErrLst), tmpList); 456 465 ReportBox(tmpList,'Cannot be released to service(s)',False); 457 466 tmpList.Free; … … 472 481 ProcDisp := DisplayGroupByName('PROC'); 473 482 ImgDisp := DisplayGroupByName('XRAY'); 483 DietDisp := DisplayGroupByName('DO'); 474 484 NonVADisp := DisplayGroupByName('NV RX'); 475 485 MedsInDlgIen := DlgIENForName('PSJ OR PAT OE'); … … 763 773 end else 764 774 begin 765 //Show Message('Order Dialogs of type "Action" are available in List Manager only.');775 //Show508Message('Order Dialogs of type "Action" are available in List Manager only.'); 766 776 Result := False; 767 777 end; … … 774 784 TC_NO_DEA = 'DEA# Required'; 775 785 TC_IMO_ERROR = 'Inpatient medication order on outpatient authorization required'; 786 TX_EVTDEL_DIET_CONFLICT = 'Have you done either of the above?'; 787 TC_EVTDEL_DIET_CONFLICT = 'Possible delayed order conflict'; 776 788 var 777 789 ResolvedDialog: TOrderDialogResolved; 778 x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr: string; 779 ODItem: integer; 780 IsInpatient, IsAnIMOOrder: boolean; 781 IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO: boolean; 790 x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr, tempUnit, tempSupply, tempDrug, tempSch: string; 791 temp,tempDur,tempQuantity, tempRefills: string; 792 i, ODItem, tempOI, ALTOI: integer; 793 DrugCheck, IsInpatient, IsAnIMOOrder, DrugTestDlgType: boolean; 794 IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO, IsNewOrder: boolean; 782 795 tmpResp: TResponse; 796 CxMsg: string; 797 AButton: TButton; 783 798 begin 784 799 IsPsoSupply := False; … … 787 802 IsAnIMOOrder := False; 788 803 ForIMO := False; 804 IsNewOrder := True; 805 PassDrugTstCall := False; 806 DrugCheck := false; 807 DrugTestDlgType := false; 808 //QOAltOI.OI := 0; 789 809 // double check environment before continuing with order 790 810 if uOrderDialog <> nil then uOrderDialog.Close; // then x := uOrderDialog.Name else x := ''; … … 792 812 if CharAt(AnID, 1) = 'X' then 793 813 begin 814 IsNewOrder := False; 815 // if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit; 794 816 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_CHANGE, x); 795 817 if ( Length(x)<1 ) and not (AnEvent.EventIFN > 0) then … … 800 822 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x; 801 823 if ShowMsgOn(Length(x) > 0, x, TC_NO_CHANGE) then Exit; 824 DrugCheck := true; 802 825 end; 803 826 if CharAt(AnID, 1) = 'C' then 804 827 begin 828 IsNewOrder := False; 829 //if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit; 805 830 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_COPY, x); 806 831 if Length(x) > 0 then 807 832 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x; 808 if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit; 833 if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit; 834 DrugCheck := true; 809 835 end; 810 836 if CharAt(AnID, 1) = 'T' then 811 837 begin 838 IsNewOrder := False; 839 if (XfInToOutNow = true) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', false)=false) then Exit; 840 if (XfInToOutNow = false) then 841 begin 842 if (XferOuttoInOnMeds = True) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', true)=false) then Exit; 843 if (XferOuttoInOnMeds = False) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', False)=false) then Exit; 844 end; 812 845 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_TRANSFER, x); 813 846 if Length(x) > 0 then … … 824 857 else if ( (IsAnIMOOrder) and (AnEvent.EventIFN <= 0) ) then 825 858 ForIMO := True; 826 827 859 OrderPtEvtID := GetOrderPtEvtID(Copy(AnID, 2, Length(AnID))); 828 860 OrderEvtID := Piece(EventInfo(OrderPtEvtID),'^',2); … … 831 863 ResolvedDialog.InputID := AnID; 832 864 BuildResponses(ResolvedDialog, GetKeyVars, AnEvent, ForIMO); 865 if (ResolvedDialog.DisplayGroup = InPtDisp) or (ResolvedDialog.DisplayGroup = ClinDisp) then DrugTestDlgType := true; 866 if (DrugCheck = true) and (ResolvedDialog.DisplayGroup = OutPtDisp) and 867 (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', false)=false) then Exit; 868 if (DrugCheck = true) and (DrugTestDlgType = true) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', true)=false) then Exit; 869 if (IsNewOrder = True) and (ResolvedDialog.DialogType = 'Q') and 870 ((ResolvedDialog.DisplayGroup = OutptDisp) or (DrugTestDlgType = true)) then 871 begin 872 if (PassDrugTest(ResolvedDialog.DialogIEN, 'Q', DrugTestDlgType)=false) then Exit 873 else PassDrugTstCall := True; 874 end; 833 875 if (ForIMO and ( (ResolvedDialog.DialogIEN = MedsInDlgIen) 834 876 or (ResolvedDialog.DialogIEN = MedsIVDlgIen)) ) then … … 866 908 if (Length(NssErr) > 1) then 867 909 begin 868 if (NssErr <> 'OTHER') then869 ShowM essage('The order contains invalid non-standard schedule.');910 if (NssErr <> 'OTHER') and (NssErr <> 'schedule is not defined.') then 911 ShowMsg('The order contains invalid non-standard schedule.'); 870 912 NSSchedule := True; 871 913 ResolvedDialog.QuickLevel := 0; … … 878 920 if not IsValidSchedule(Copy(AnID, 2, Length(AnID))) then 879 921 begin 880 ShowM essage('The order contains invalid non-standard schedule.');922 ShowMsg('The order contains invalid non-standard schedule.'); 881 923 NSSchedule := True; 882 924 end; … … 884 926 if NSSchedule then ResolvedDialog.QuickLevel := 0; 885 927 end; 928 (* if (ResolvedDialog.DialogType = 'Q') and ((ResolvedDialog.FormID = OD_MEDINPT) or (ResolvedDialog.FormID = OD_MEDOUTPT)) then 929 begin 930 temp := ''; 931 tempOI := GetQOOrderableItem(ResolvedDialog.InputID); 932 if tempOI >0 then 933 begin 934 ALTOI := tempOI; 935 CheckFormularyOI(AltOI,temp,True); 936 if ALTOI <> tempOI then 937 begin 938 ResolvedDialog.QuickLevel := 0; 939 QOAltOI.OI := ALTOI; 940 end; 941 end; 942 end; *) 943 // ((ResolvedDialog.DisplayGroup = InptDisp) or (ResolvedDialog.DisplayGroup = OutptDisp) or (ResolvedDialog.DisplayGroup = MedsDisp)) then 944 // ResolvedDialog.QuickLevel := 0; 886 945 with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG; 946 947 // Check for potential conflicting auto-accept delayed-release diet orders (CQ #10946 - v27.36 - RV) 948 with ResolvedDialog do if (QuickLevel = QL_AUTO) and (DisplayGroup = DietDisp) and (AnEvent.EventType <> 'C') then 949 begin 950 AButton := TButton.Create(Application); 951 try 952 CheckForAutoDCDietOrders(AnEvent.EventIFN, DisplayGroup, '', CxMsg, AButton); 953 if CxMsg <> '' then 954 begin 955 if InfoBox(CxMsg + CRLF + CRLF + TX_EVTDEL_DIET_CONFLICT, 956 TC_EVTDEL_DIET_CONFLICT, 957 MB_ICONWARNING or MB_YESNO) = ID_NO 958 then QuickLevel := QL_DIALOG; 959 end; 960 finally 961 AButton.Free; 962 end; 963 end; 964 887 965 with ResolvedDialog do 888 966 begin … … 1035 1113 else 1036 1114 begin 1115 if uOrderDialog.DisplayGroup = OutptDisp then 1116 begin 1117 tempUnit := ''; 1118 tempSupply := ''; 1119 tempDrug := ''; 1120 tempSch := ''; 1121 tempDur := ''; 1122 tmpResp := uOrderDialog.Responses.FindResponseByName('SUPPLY', 1); 1123 if tmpResp = nil then tempSupply := '0' 1124 else tempSupply := tmpResp.EValue; 1125 tmpResp := uOrderDialog.Responses.FindResponseByName('QTY', 1); 1126 if tmpResp = nil then tempQuantity := '0' 1127 else tempQuantity := tmpResp.EValue; 1128 tmpResp := uOrderDialog.Responses.FindResponseByName('REFILLS', 1); 1129 if tmpResp = nil then tempRefills := '0' 1130 else tempRefills := tmpResp.EValue; 1131 tmpResp := uOrderDialog.Responses.FindResponseByName('ORDERABLE', 1); 1132 tempOI := StrToIntDef(tmpResp.IValue,0); 1133 i := uORderDialog.Responses.NextInstance('DOSE',0); 1134 while i > 0 do 1135 begin 1136 x := Piece(uOrderDialog.Responses.IValueFor('DOSE',i), '&', 3); 1137 tempUnit := tempUnit + X + U; 1138 x := uOrderDialog.Responses.IValueFor('SCHEDULE',i); 1139 tempSch := tempSch + x + U; 1140 x := uOrderDialog.Responses.IValueFor('DRUG', i); 1141 tempDrug := Piece(x, U, 1); 1142 i := Responses.NextInstance('DOSE', i); 1143 x := UORderDialog.Responses.IValueFor('DAYS', i); 1144 tempDur := tempDur + x + '~'; 1145 x := uOrderDialog.Responses.IValueFor('CONJ', i); 1146 tempDur := tempDur + x + U; 1147 end; 1148 if ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur, tempOI, StrtoInt(tempSupply), StrtoInt(tempQuantity), StrtoInt(tempRefills)) = false then Exit; 1149 end; 1037 1150 cmdAcceptClick(Application); // auto-accept order 1038 1151 Result := uOrderDialog.AcceptOK; 1039 1152 1040 1153 //BAPHII 1.3.2 1041 // showmessage('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');1154 //Show508Message('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()'); 1042 1155 1043 1156 //End BAPHII 1.3.2 … … 1061 1174 if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder) 1062 1175 then UnlockOrder(EditedOrder); 1063 1176 //QOAltOI.OI := 0; 1064 1177 end; 1065 1178 … … 1112 1225 uOrderHTML.ShowModal; 1113 1226 ASetList := TStringList.Create; 1114 ASetList.Assign(uOrderHTML.SetList);1227 FastAssign(uOrderHTML.SetList, ASetList); 1115 1228 uOrderHTML.Release; 1116 1229 if ASetList.Count = 0 then Exit; … … 1669 1782 end; 1670 1783 1671 1672 procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0); 1784 procedure PrintOrdersOnSignReleaseMult(OrderList, ClinicLst, WardLst: TStringList; Nature: Char; EncLoc, WardLoc: integer; 1785 EncLocName, WardLocName: string); 1786 var 1787 i,j: integer; 1788 tempOrder: string; 1789 tempOrderList: TStringList; 1790 begin 1791 tempOrderList := TStringList.Create; 1792 if (ClinicLst <> nil) and (ClinicLst.Count > 0) then 1793 begin 1794 for i := 0 to ClinicLst.Count - 1 do 1795 begin 1796 tempOrder := ClinicLst.Strings[i]; 1797 for j := 0 to OrderList.Count - 1 do 1798 if Piece(OrderList.Strings[j], U,1) = tempOrder then tempOrderList.Add(OrderList.Strings[j]); 1799 end; 1800 if tempOrderList.Count > 0 then PrintOrdersOnSignRelease(tempOrderList, Nature, EncLoc, EncLocName); 1801 end; 1802 if (WardLst <> nil) and (WardLst.Count > 0) then 1803 begin 1804 if tempOrderList.Count > 0 then 1805 begin 1806 tempOrderList.Free; 1807 tempOrderList := TStringList.Create; 1808 end; 1809 for i := 0 to WardLst.Count - 1 do 1810 begin 1811 tempOrder := WardLst.Strings[i]; 1812 for j := 0 to OrderList.Count - 1 do 1813 if Piece(OrderList.Strings[j], U,1) = tempOrder then tempOrderList.Add(OrderList.Strings[j]); 1814 end; 1815 if tempOrderList.Count > 0 then PrintOrdersOnSignRelease(tempOrderList, Nature, WardLoc, WardLocName); 1816 end; 1817 tempOrderList.Free; 1818 end; 1819 1820 procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = ''); 1673 1821 const 1674 1822 TX_NEW_LOC1 = 'The patient''s location has changed to '; … … 1691 1839 then Encounter.Location := ALocation; 1692 1840 end; 1693 end 1694 else 1695 Encounter.Location := PrintLoc; 1841 end; 1842 //else 1843 //Encounter.Location := PrintLoc; 1844 if PrintLoc = 0 1845 then PrintLoc := CommonLocationForOrders(OrderList); 1846 if (PrintLoc = 0) and (Encounter.Location > 0) then PrintLoc := Encounter.Location; 1847 1848 if PrintLoc = 0 then // location required for DEVINFO 1849 begin 1850 LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT); 1851 if ALocation > 0 then 1852 begin 1853 PrintLoc := ALocation; 1854 Encounter.Location := ALocation; 1855 end; 1856 end; 1857 if printLoc = 0 then frmFrame.DisplayEncounterText; 1858 if PrintLoc <> 0 then 1859 begin 1860 SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName, PrintLoc); 1861 if PrintIt then 1862 PrintOrdersOnReview(OrderList, DeviceInfo, PrintLoc) 1863 else 1864 PrintServiceCopies(OrderList, PrintLoc); 1865 end 1866 else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); 1867 (* Encounter.Location := PrintLoc; 1696 1868 if Encounter.Location = 0 1697 1869 then Encounter.Location := CommonLocationForOrders(OrderList); … … 1701 1873 if ALocation > 0 then Encounter.Location := ALocation; 1702 1874 end; 1703 frmFrame.DisplayEncounterText;1875 if printLoc = 0 then frmFrame.DisplayEncounterText; 1704 1876 if Encounter.Location <> 0 then 1705 1877 begin 1706 SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt );1878 SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName); 1707 1879 if PrintIt then 1708 1880 PrintOrdersOnReview(OrderList, DeviceInfo) … … 1710 1882 PrintServiceCopies(OrderList); 1711 1883 end 1712 else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); 1884 else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); *) 1713 1885 end; 1714 1886 … … 1731 1903 NMRec.LastIndex := NewIndex; 1732 1904 end; 1905 1906 (*function GetQOAltOI: integer; 1907 begin 1908 Result := QOAltOI.OI; 1909 end; *) 1733 1910 1734 1911 function IsIMODialog(DlgID: integer): boolean; //IMO -
cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.dfm
r456 r829 1 objectfrmTemplateAutoGen: TfrmTemplateAutoGen1 inherited frmTemplateAutoGen: TfrmTemplateAutoGen 2 2 Left = 361 3 3 Top = 230 … … 8 8 ClientHeight = 213 9 9 ClientWidth = 415 10 Color = clBtnFace11 Font.Charset = DEFAULT_CHARSET12 Font.Color = clWindowText13 Font.Height = -1114 Font.Name = 'MS Sans Serif'15 Font.Style = []16 OldCreateOrder = False17 10 Position = poScreenCenter 18 11 OnShow = FormShow 19 12 PixelsPerInch = 96 20 13 TextHeight = 13 21 object lblTop: TMemo 14 object lblTop: TMemo [0] 22 15 Left = 256 23 16 Top = 8 … … 35 28 TabOrder = 5 36 29 end 37 object lblSelect: TStaticText 30 object lblSelect: TStaticText [1] 38 31 Left = 0 39 32 Top = 0 … … 46 39 TabOrder = 6 47 40 end 48 object rgSource: TKeyClickRadioGroup 41 object rgSource: TKeyClickRadioGroup [2] 49 42 Left = 256 50 43 Top = 88 … … 59 52 OnClick = rgSourceClick 60 53 end 61 object cbxObjects: TORComboBox 54 object cbxObjects: TORComboBox [3] 62 55 Left = 0 63 56 Top = 0 … … 74 67 ListItemsOnly = False 75 68 LongList = False 69 LookupPiece = 0 76 70 MaxLength = 0 77 71 Pieces = '1' … … 81 75 Visible = False 82 76 OnDblClick = cbxObjectsDblClick 77 CharsNeedMatch = 1 83 78 end 84 object btnOK: TButton 79 object btnOK: TButton [4] 85 80 Left = 257 86 81 Top = 190 … … 92 87 TabOrder = 3 93 88 end 94 object btnCancel: TButton 89 object btnCancel: TButton [5] 95 90 Left = 337 96 91 Top = 190 … … 102 97 TabOrder = 4 103 98 end 104 object cbxTitles: TORComboBox 99 object cbxTitles: TORComboBox [6] 105 100 Left = 0 106 101 Top = 0 … … 117 112 ListItemsOnly = True 118 113 LongList = True 114 LookupPiece = 0 119 115 MaxLength = 0 120 116 Pieces = '2' … … 125 121 OnDblClick = cbxTitlesDblClick 126 122 OnNeedData = cbxTitlesNeedData 123 CharsNeedMatch = 1 124 end 125 inherited amgrMain: TVA508AccessibilityManager 126 Data = ( 127 ( 128 'Component = lblTop' 129 'Status = stsDefault') 130 ( 131 'Component = lblSelect' 132 'Status = stsDefault') 133 ( 134 'Component = rgSource' 135 'Status = stsDefault') 136 ( 137 'Component = cbxObjects' 138 'Status = stsDefault') 139 ( 140 'Component = btnOK' 141 'Status = stsDefault') 142 ( 143 'Component = btnCancel' 144 'Status = stsDefault') 145 ( 146 'Component = cbxTitles' 147 'Status = stsDefault') 148 ( 149 'Component = frmTemplateAutoGen' 150 'Status = stsDefault')) 127 151 end 128 152 end -
cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORCtrls, ExtCtrls, ORFn ;7 StdCtrls, ORCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmTemplateAutoGen = class(T Form)10 TfrmTemplateAutoGen = class(TfrmBase508Form) 11 11 rgSource: TKeyClickRadioGroup; 12 12 cbxObjects: TORComboBox; … … 121 121 end; 122 122 if DoIt then 123 cbxObjects.Items.Assign(dmodShared.TIUObjects);123 FastAssign(dmodShared.TIUObjects, cbxObjects.Items); 124 124 FObjectsDone := TRUE; 125 125 end; -
cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.dfm
r456 r829 1 objectfrmTemplateDialog: TfrmTemplateDialog1 inherited frmTemplateDialog: TfrmTemplateDialog 2 2 Left = 268 3 3 Top = 155 4 Width = 6405 Height = 4406 4 BorderIcons = [biSystemMenu, biMaximize] 7 5 Caption = 'Text Dialog' 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 = False 6 ClientHeight = 413 7 ClientWidth = 632 15 8 Position = poScreenCenter 16 9 OnClose = FormClose … … 19 12 OnDestroy = FormDestroy 20 13 OnPaint = FormPaint 14 OnShow = FormShow 15 ExplicitWidth = 640 16 ExplicitHeight = 440 21 17 PixelsPerInch = 96 22 18 TextHeight = 13 23 object sbMain: TScrollBox 19 object sbMain: TScrollBox [0] 24 20 Left = 0 25 21 Top = 0 … … 36 32 TabOrder = 0 37 33 end 38 object pnlBottom: TScrollBox 34 object pnlBottom: TScrollBox [1] 39 35 Left = 0 40 36 Top = 375 … … 100 96 end 101 97 end 98 inherited amgrMain: TVA508AccessibilityManager 99 Data = ( 100 ( 101 'Component = sbMain' 102 'Status = stsDefault') 103 ( 104 'Component = pnlBottom' 105 'Status = stsDefault') 106 ( 107 'Component = lblFootnote' 108 'Status = stsDefault') 109 ( 110 'Component = btnCancel' 111 'Status = stsDefault') 112 ( 113 'Component = btnOK' 114 'Status = stsDefault') 115 ( 116 'Component = btnAll' 117 'Status = stsDefault') 118 ( 119 'Component = btnNone' 120 'Status = stsDefault') 121 ( 122 'Component = btnPreview' 123 'Status = stsDefault') 124 ( 125 'Component = frmTemplateDialog' 126 'Status = stsDefault')) 127 end 102 128 end -
cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates; 7 StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, fBase508Form, uConst, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmTemplateDialog = class(T Form)11 TfrmTemplateDialog = class(TfrmBase508Form) 11 12 sbMain: TScrollBox; 12 13 pnlBottom: TScrollBox; … … 26 27 procedure btnPreviewClick(Sender: TObject); 27 28 procedure FormClose(Sender: TObject; var Action: TCloseAction); 29 procedure FormShow(Sender: TObject); 28 30 private 31 FFirstBuild: boolean; 29 32 SL: TStrings; 30 33 BuildIdx: TStringList; … … 57 60 procedure ParentCBEnter(Sender: TObject); 58 61 procedure ParentCBExit(Sender: TObject); 62 procedure UMScreenReaderInit(var Message: TMessage); message UM_MISC; 63 procedure InitScreenReaderSetup; 59 64 public 60 65 property Silent: boolean read FSilent write FSilent ; … … 72 77 implementation 73 78 74 uses dShared, uConst, uTemplateFields, fRptBox, uInit, rMisc; 79 uses dShared, uTemplateFields, fRptBox, uInit, rMisc, uDlgComponents, 80 VA508AccessibilityRouter, VAUtils; 75 81 76 82 {$R *.DFM} … … 187 193 Result := FALSE; 188 194 CancelDlg := FALSE; 195 SetTemplateDialogCanceled(FALSE); 189 196 frmTemplateDialog := TfrmTemplateDialog.Create(Application); 190 197 try … … 272 279 end; 273 280 274 if not Result then 281 if Result then 282 SetTemplateDialogCanceled(TRUE) 283 else 284 begin 285 SetTemplateDialogCanceled(FALSE); 275 286 CheckBoilerplate4Fields(SL, CaptionText, PreviewMode); 276 287 end; 288 277 289 end; 278 290 … … 289 301 SL.Clear; 290 302 end; 303 StripScreenReaderCodes(SL); 291 304 end; 292 305 … … 380 393 end; 381 394 395 procedure TfrmTemplateDialog.InitScreenReaderSetup; 396 var 397 ctrl: TWinControl; 398 list: TList; 399 begin 400 if ScreenReaderSystemActive then 401 begin 402 list := TList.Create; 403 try 404 sbMain.GetTabOrderList(list); 405 if list.Count > 0 then 406 begin 407 ctrl := TWinControl(list[0]); 408 PostMessage(Handle, UM_MISC, WParam(ctrl), 0); 409 end; 410 finally 411 list.free; 412 end; 413 end; 414 end; 415 382 416 function TfrmTemplateDialog.IsAncestor( OldID: string; NewID: string): boolean; 383 417 begin … … 398 432 KillCtrl, doHint, dsp, noTextParent: boolean; 399 433 Entry: TTemplateDialogEntry; 400 StringIn, StringOut: string; 434 // StringIn, StringOut: string; 435 cb: TCPRSDialogParentCheckBox; 401 436 402 437 procedure NextTabCtrl(ACtrl: TControl); … … 511 546 Entry := TTemplateDialogEntry(Entries.Objects[idx]); 512 547 513 pnl := Entry.GetPanel(FMaxPnlWidth, sbMain); 548 if(dsp or OneOnly) then 549 cb := nil 550 else 551 cb := TCPRSDialogParentCheckBox.Create(Self); 552 553 pnl := Entry.GetPanel(FMaxPnlWidth, sbMain, cb); 514 554 pnl.Show; 515 555 if(doHint and (not pnl.ShowHint)) then … … 521 561 Entry.OnChange := FieldChanged; 522 562 end; 523 if (dsp or OneOnly) then563 if not assigned(cb) then 524 564 ctrl := pnl 525 565 else 526 566 begin 527 ctrl := TORCheckBox.Create(Self);567 ctrl := cb; 528 568 ctrl.Parent := sbMain; 529 569 … … 539 579 TORCheckBox(ctrl).AutoSize := false; 540 580 TORCheckBox(ctrl).Associate := pnl; 581 pnl.Tag := Integer(ctrl); 541 582 tmpID := copy(ID, 1, (pos('.', ID) - 1)); {copy the ID without the decimal place} 542 if Templates.IndexOf(tmpID) > -1 then 543 StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName 544 else 545 StringIn := 'Sub-Template:'; 546 StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]); 547 TORCheckBox(ctrl).Caption := StringOut; 583 // if Templates.IndexOf(tmpID) > -1 then 584 // StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName 585 // else 586 // StringIn := 'Sub-Template:'; 587 // StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]); 588 // TORCheckBox(ctrl).Caption := StringOut; 589 UpdateColorsFor508Compliance(ctrl); 548 590 549 591 end; … … 615 657 for i := 1 to Count do 616 658 BuildCB(i, Y, FirstTime); 659 if ScreenReaderSystemActive then 660 begin 661 amgrMain.RefreshComponents; 662 Application.ProcessMessages; 663 end; 617 664 finally 618 665 FBuilding := FALSE; … … 626 673 RepaintBuild := FALSE; 627 674 BuildAllControls; 675 InitScreenReaderSetup; 676 end; 677 end; 678 679 procedure TfrmTemplateDialog.FormShow(Sender: TObject); 680 begin 681 inherited; 682 if FFirstBuild then 683 begin 684 FFirstBuild := FALSE; 685 InitScreenReaderSetup; 628 686 end; 629 687 end; … … 631 689 procedure TfrmTemplateDialog.FormCreate(Sender: TObject); 632 690 begin 691 FFirstBuild := TRUE; 633 692 BuildIdx := TStringList.Create; 634 693 Entries := TStringList.Create; … … 700 759 if not CanClose then 701 760 begin 702 ShowM essage(MissingFieldsTxt);761 ShowMsg(MissingFieldsTxt); 703 762 break; 704 763 end; … … 719 778 TmpSL := TStringList.Create; 720 779 try 721 TmpSL.Assign(SL);780 FastAssign(SL, TmpSL); 722 781 GetText(TmpSL, FALSE); {FALSE = Do not include embedded fields} 782 StripScreenReaderCodes(TmpSL); 723 783 ReportBox(TmpSL, 'Dialog Preview', FALSE); 724 784 finally … … 755 815 end; 756 816 817 procedure TfrmTemplateDialog.UMScreenReaderInit(var Message: TMessage); 818 var 819 ctrl: TWinControl; 820 item: TVA508AccessibilityItem; 821 begin 822 ctrl := TWinControl(Message.WParam); 823 // Refresh the accessibility manager entry - 824 // fixes bug where first focusable check boxes weren't working correctly 825 if ctrl is TCPRSDialogParentCheckBox then 826 begin 827 item := amgrMain.AccessData.FindItem(ctrl, FALSE); 828 if assigned(item) then 829 item.free; 830 amgrMain.AccessData.EnsureItemExists(ctrl); 831 end; 832 end; 833 757 834 end. 758 835 -
cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.dfm
r456 r829 1 object frmTemplateEditor: TfrmTemplateEditor 2 Left = 135 3 Top = 239 4 Width = 748 5 Height = 470 1 inherited frmTemplateEditor: TfrmTemplateEditor 2 Left = 321 3 Top = 119 6 4 HelpContext = 10000 7 5 ActiveControl = tvPersonal 8 6 BorderIcons = [biSystemMenu, biMaximize] 9 7 Caption = 'Template Editor' 10 Color = clBtnFace 11 Font.Charset = DEFAULT_CHARSET 12 Font.Color = clWindowText 13 Font.Height = -11 14 Font.Name = 'MS Sans Serif' 15 Font.Style = [] 16 OldCreateOrder = False 8 ClientHeight = 450 9 ClientWidth = 740 17 10 Position = poScreenCenter 18 11 Scaled = False 12 OnClose = FormClose 19 13 OnCloseQuery = FormCloseQuery 20 14 OnCreate = FormCreate 21 15 OnDestroy = FormDestroy 22 16 OnShow = FormShow 17 ExplicitWidth = 748 18 ExplicitHeight = 477 23 19 PixelsPerInch = 96 24 20 TextHeight = 13 25 object splMain: TSplitter 21 object splMain: TSplitter [0] 26 22 Left = 0 27 23 Top = 239 … … 35 31 OnMoved = splMainMoved 36 32 end 37 object splNotes: TSplitter 33 object splNotes: TSplitter [1] 38 34 Left = 0 39 Top = 37 135 Top = 377 40 36 Width = 740 41 37 Height = 3 … … 46 42 Visible = False 47 43 OnMoved = splBoilMoved 44 ExplicitTop = 371 48 45 end 49 object pnlBottom: T ORAutoPanel46 object pnlBottom: TPanel [2] 50 47 Left = 0 51 Top = 4 1648 Top = 423 52 49 Width = 740 53 50 Height = 27 … … 55 52 BevelOuter = bvNone 56 53 TabOrder = 4 54 ExplicitTop = 416 57 55 DesignSize = ( 58 56 740 … … 130 128 end 131 129 end 132 object pnlBoilerplate: TPanel 130 object pnlBoilerplate: TPanel [3] 133 131 Left = 0 134 132 Top = 284 135 133 Width = 740 136 Height = 87134 Height = 93 137 135 Align = alClient 138 136 BevelOuter = bvNone … … 142 140 object splBoil: TSplitter 143 141 Left = 0 144 Top = 43142 Top = 14 145 143 Width = 740 146 144 Height = 3 147 145 Cursor = crVSplit 148 Align = al Bottom146 Align = alTop 149 147 AutoSnap = False 150 148 Beveled = True 151 149 Visible = False 152 150 OnMoved = splBoilMoved 151 ExplicitTop = 43 153 152 end 154 153 object reBoil: TRichEdit 155 154 Left = 0 156 Top = 1 4155 Top = 17 157 156 Width = 740 158 Height = 29157 Height = 30 159 158 Align = alClient 160 159 Font.Charset = ANSI_CHARSET … … 163 162 Font.Name = 'Courier New' 164 163 Font.Style = [] 164 Constraints.MinHeight = 30 165 165 ParentFont = False 166 166 PlainText = True … … 175 175 OnResizeRequest = reResizeRequest 176 176 OnSelectionChange = reBoilSelectionChange 177 ExplicitTop = 14 177 178 end 178 179 object pnlGroupBP: TPanel 179 180 Left = 0 180 Top = 4 6181 Top = 47 181 182 Width = 740 182 Height = 4 1183 Height = 46 183 184 Align = alBottom 184 185 BevelOuter = bvNone … … 192 193 Align = alTop 193 194 Caption = 'Group Boilerplate' 195 ExplicitWidth = 81 194 196 end 195 197 object lblGroupRow: TLabel … … 211 213 Top = 16 212 214 Width = 740 213 Height = 25215 Height = 30 214 216 Align = alClient 215 217 Color = clCream … … 219 221 Font.Name = 'Courier New' 220 222 Font.Style = [] 223 Constraints.MinHeight = 30 221 224 ParentFont = False 222 225 PlainText = True … … 281 284 end 282 285 end 283 object pnlTop: TPanel 286 object pnlTop: TPanel [4] 284 287 Left = 0 285 288 Top = 0 … … 293 296 Left = 297 294 297 Top = 24 295 Width = 3296 298 Height = 215 297 Cursor = crHSplit298 299 Align = alRight 299 300 AutoSnap = False … … 319 320 Left = 216 320 321 Top = 0 321 Width = 3322 322 Height = 215 323 Cursor = crHSplit324 323 Align = alRight 325 324 AutoSnap = False … … 428 427 FocusControl = tvPersonal 429 428 PopupMenu = popTemplates 429 ExplicitWidth = 93 430 430 end 431 431 object tvPersonal: TORTreeView … … 716 716 ShowHint = True 717 717 TabOrder = 5 718 WordWrap = True 718 719 OnClick = cbExcludeClick 719 WordWrap = True720 720 AutoSize = True 721 721 end … … 760 760 'erplate, between each item'#39's boilerplate.' 761 761 Associate = edtGap 762 Min = 0763 762 Max = 3 764 763 ParentShowHint = False 765 Position = 0766 764 ShowHint = True 767 765 TabOrder = 8 768 Wrap = False769 766 end 770 767 object edtName: TCaptionEdit … … 871 868 ShowHint = True 872 869 TabOrder = 4 870 WordWrap = True 873 871 OnClick = cbHideItemsClick 874 WordWrap = True875 872 AutoSize = True 876 873 end … … 913 910 TabOrder = 2 914 911 OnChange = cbxRemDlgsChange 912 CharsNeedMatch = 1 915 913 end 916 914 object cbLock: TORCheckBox … … 943 941 FocusControl = tvShared 944 942 PopupMenu = popTemplates 943 ExplicitWidth = 86 945 944 end 946 945 object tvShared: TORTreeView … … 1188 1187 OnChange = cboOwnerChange 1189 1188 OnNeedData = cboOwnerNeedData 1189 CharsNeedMatch = 1 1190 1190 end 1191 1191 object btnNew: TORAlignButton … … 1194 1194 Width = 182 1195 1195 Height = 22 1196 Align = alRight 1196 1197 Caption = '&New Template' 1197 1198 TabOrder = 2 1198 1199 OnClick = btnNewClick 1199 Align = alRight1200 1200 end 1201 1201 object pnlMenu: TPanel … … 1212 1212 Left = 1 1213 1213 Top = 1 1214 Width = 691214 Width = 107 1215 1215 Height = 20 1216 1216 Align = alLeft … … 1219 1219 ButtonWidth = 43 1220 1220 Caption = 'mbMain' 1221 Flat = True1222 1221 Menu = mnuMain 1223 1222 ShowCaptions = True … … 1228 1227 end 1229 1228 end 1230 object pnlNotes: TPanel 1229 object pnlNotes: TPanel [5] 1231 1230 Left = 0 1232 Top = 3 741231 Top = 380 1233 1232 Width = 740 1234 Height = 4 21233 Height = 43 1235 1234 Align = alBottom 1236 1235 BevelOuter = bvNone … … 1244 1243 Align = alTop 1245 1244 Caption = 'Template Notes:' 1245 ExplicitWidth = 78 1246 1246 end 1247 1247 object reNotes: TRichEdit … … 1249 1249 Top = 13 1250 1250 Width = 740 1251 Height = 291251 Height = 30 1252 1252 Align = alClient 1253 1253 Font.Charset = ANSI_CHARSET … … 1256 1256 Font.Name = 'Courier New' 1257 1257 Font.Style = [] 1258 Constraints.MinHeight = 30 1258 1259 ParentFont = False 1259 1260 PlainText = True … … 1269 1270 end 1270 1271 end 1271 object pnlCOM: TPanel 1272 object pnlCOM: TPanel [6] 1272 1273 Left = 0 1273 1274 Top = 263 … … 1286 1287 Caption = ' Passed Value: ' 1287 1288 Layout = tlCenter 1289 ExplicitHeight = 13 1288 1290 end 1289 1291 object lblCOMObj: TLabel … … 1295 1297 Caption = ' COM Object: ' 1296 1298 Layout = tlCenter 1299 ExplicitHeight = 13 1297 1300 end 1298 1301 object edtCOMParam: TCaptionEdit … … 1301 1304 Width = 380 1302 1305 Height = 21 1306 Align = alClient 1303 1307 TabOrder = 0 1304 1308 OnChange = edtCOMParamChange 1305 Align = alClient1306 1309 Caption = 'Passed Value' 1307 1310 end … … 1329 1332 TabOrder = 1 1330 1333 OnChange = cbxCOMObjChange 1334 CharsNeedMatch = 1 1331 1335 end 1332 1336 end 1333 object pnlLink: TPanel 1337 object pnlLink: TPanel [7] 1334 1338 Left = 0 1335 1339 Top = 242 … … 1348 1352 Caption = ' Associated Consult Service: ' 1349 1353 Layout = tlCenter 1354 ExplicitHeight = 13 1350 1355 end 1351 1356 object cbxLink: TORComboBox … … 1367 1372 LookupPiece = 0 1368 1373 MaxLength = 0 1369 Pieces = '2 ,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,1'1374 Pieces = '2' 1370 1375 HideSynonyms = True 1371 1376 Sorted = False … … 1376 1381 OnChange = cbxLinkChange 1377 1382 OnNeedData = cbxLinkNeedData 1378 OnSynonymCheck = cbxLinkSynonymCheck 1379 end 1383 CharsNeedMatch = 1 1384 end 1385 end 1386 inherited amgrMain: TVA508AccessibilityManager 1387 Data = ( 1388 ( 1389 'Component = pnlBottom' 1390 'Status = stsDefault') 1391 ( 1392 'Component = btnApply' 1393 'Status = stsDefault') 1394 ( 1395 'Component = btnCancel' 1396 'Status = stsDefault') 1397 ( 1398 'Component = btnOK' 1399 'Status = stsDefault') 1400 ( 1401 'Component = cbEditShared' 1402 'Status = stsDefault') 1403 ( 1404 'Component = cbNotes' 1405 'Status = stsDefault') 1406 ( 1407 'Component = cbEditUser' 1408 'Status = stsDefault') 1409 ( 1410 'Component = pnlBoilerplate' 1411 'Status = stsDefault') 1412 ( 1413 'Component = reBoil' 1414 'Label = lblBoilerplate' 1415 'Status = stsOK') 1416 ( 1417 'Component = pnlGroupBP' 1418 'Status = stsDefault') 1419 ( 1420 'Component = reGroupBP' 1421 'Label = lblGroupBP' 1422 'Status = stsOK') 1423 ( 1424 'Component = pnlGroupBPGap' 1425 'Status = stsDefault') 1426 ( 1427 'Component = pnlBP' 1428 'Status = stsDefault') 1429 ( 1430 'Component = cbLongLines' 1431 'Status = stsDefault') 1432 ( 1433 'Component = pnlTop' 1434 'Status = stsDefault') 1435 ( 1436 'Component = pnlRightTop' 1437 'Status = stsDefault') 1438 ( 1439 'Component = pnlCopyBtns' 1440 'Status = stsDefault') 1441 ( 1442 'Component = sbCopyRight' 1443 'Property = Hint' 1444 'Status = stsOK') 1445 ( 1446 'Component = sbCopyLeft' 1447 'Property = Hint' 1448 'Status = stsOK') 1449 ( 1450 'Component = pnlPersonal' 1451 'Status = stsDefault') 1452 ( 1453 'Component = tvPersonal' 1454 'Status = stsDefault') 1455 ( 1456 'Component = pnlPersonalBottom' 1457 'Status = stsDefault') 1458 ( 1459 'Component = sbPerUp' 1460 'Property = Hint' 1461 'Status = stsOK') 1462 ( 1463 'Component = sbPerDown' 1464 'Property = Hint' 1465 'Status = stsOK') 1466 ( 1467 'Component = sbPerDelete' 1468 'Property = Hint' 1469 'Status = stsOK') 1470 ( 1471 'Component = cbPerHide' 1472 'Property = Hint' 1473 'Status = stsOK') 1474 ( 1475 'Component = pnlPersonalGap' 1476 'Status = stsDefault') 1477 ( 1478 'Component = pnlPerSearch' 1479 'Status = stsDefault') 1480 ( 1481 'Component = btnPerFind' 1482 'Text = Find Personal Template' 1483 'Status = stsOK') 1484 ( 1485 'Component = edtPerSearch' 1486 'Status = stsDefault') 1487 ( 1488 'Component = cbPerMatchCase' 1489 'Status = stsDefault') 1490 ( 1491 'Component = cbPerWholeWords' 1492 'Status = stsDefault') 1493 ( 1494 'Component = pnlProperties' 1495 'Status = stsDefault') 1496 ( 1497 'Component = gbProperties' 1498 'Status = stsDefault') 1499 ( 1500 'Component = cbExclude' 1501 'Status = stsDefault') 1502 ( 1503 'Component = cbActive' 1504 'Status = stsDefault') 1505 ( 1506 'Component = edtGap' 1507 'Status = stsDefault') 1508 ( 1509 'Component = udGap' 1510 'Status = stsDefault') 1511 ( 1512 'Component = edtName' 1513 'Status = stsDefault') 1514 ( 1515 'Component = gbDialogProps' 1516 'Status = stsDefault') 1517 ( 1518 'Component = cbDisplayOnly' 1519 'Status = stsDefault') 1520 ( 1521 'Component = cbOneItemOnly' 1522 'Status = stsDefault') 1523 ( 1524 'Component = cbFirstLine' 1525 'Status = stsDefault') 1526 ( 1527 'Component = cbHideDlgItems' 1528 'Status = stsDefault') 1529 ( 1530 'Component = cbIndent' 1531 'Status = stsDefault') 1532 ( 1533 'Component = cbHideItems' 1534 'Status = stsDefault') 1535 ( 1536 'Component = cbxType' 1537 'Status = stsDefault') 1538 ( 1539 'Component = cbxRemDlgs' 1540 'Status = stsDefault') 1541 ( 1542 'Component = cbLock' 1543 'Status = stsDefault') 1544 ( 1545 'Component = pnlShared' 1546 'Status = stsDefault') 1547 ( 1548 'Component = tvShared' 1549 'Status = stsDefault') 1550 ( 1551 'Component = pnlSharedBottom' 1552 'Status = stsDefault') 1553 ( 1554 'Component = sbShUp' 1555 'Property = Hint' 1556 'Status = stsOK') 1557 ( 1558 'Component = sbShDown' 1559 'Property = Hint' 1560 'Status = stsOK') 1561 ( 1562 'Component = sbShDelete' 1563 'Property = Hint' 1564 'Status = stsOK') 1565 ( 1566 'Component = cbShHide' 1567 'Property = Hint' 1568 'Status = stsOK') 1569 ( 1570 'Component = pnlSharedGap' 1571 'Status = stsDefault') 1572 ( 1573 'Component = pnlShSearch' 1574 'Status = stsDefault') 1575 ( 1576 'Component = btnShFind' 1577 'Text = Find Shared Template' 1578 'Status = stsOK') 1579 ( 1580 'Component = edtShSearch' 1581 'Status = stsDefault') 1582 ( 1583 'Component = cbShMatchCase' 1584 'Status = stsDefault') 1585 ( 1586 'Component = cbShWholeWords' 1587 'Status = stsDefault') 1588 ( 1589 'Component = pnlMenuBar' 1590 'Status = stsDefault') 1591 ( 1592 'Component = cboOwner' 1593 'Status = stsDefault') 1594 ( 1595 'Component = btnNew' 1596 'Status = stsDefault') 1597 ( 1598 'Component = pnlMenu' 1599 'Status = stsDefault') 1600 ( 1601 'Component = mbMain' 1602 'Status = stsDefault') 1603 ( 1604 'Component = pnlNotes' 1605 'Status = stsDefault') 1606 ( 1607 'Component = reNotes' 1608 'Label = lblNotes' 1609 'Status = stsOK') 1610 ( 1611 'Component = pnlCOM' 1612 'Status = stsDefault') 1613 ( 1614 'Component = edtCOMParam' 1615 'Label = lblCOMParam' 1616 'Status = stsOK') 1617 ( 1618 'Component = cbxCOMObj' 1619 'Property = Caption' 1620 'Status = stsOK') 1621 ( 1622 'Component = pnlLink' 1623 'Status = stsDefault') 1624 ( 1625 'Component = cbxLink' 1626 'Label = lblLink' 1627 'Status = stsOK') 1628 ( 1629 'Component = frmTemplateEditor' 1630 'Status = stsDefault')) 1380 1631 end 1381 1632 object popTemplates: TPopupMenu … … 1750 2001 Top = 136 1751 2002 end 2003 object imgLblTemplates: TVA508ImageListLabeler 2004 Components = < 2005 item 2006 Component = tvPersonal 2007 end 2008 item 2009 Component = tvShared 2010 end> 2011 Labels = <> 2012 RemoteLabeler = dmodShared.imgLblHealthFactorLabels 2013 Left = 104 2014 Top = 144 2015 end 1752 2016 end -
cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.pas
r456 r829 18 18 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 19 19 ExtCtrls, StdCtrls, ComCtrls, ORCtrls, Buttons, Mask, ORFn, ORNet, 20 uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB; 20 uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB, fBase508Form, 21 VA508AccessibilityManager, VA508ImageListLabeler; 21 22 22 23 type … … 24 25 TTemplateTreeType = (ttShared, ttPersonal); 25 26 26 TfrmTemplateEditor = class(T Form)27 TfrmTemplateEditor = class(TfrmBase508Form) 27 28 splMain: TSplitter; 28 pnlBottom: T ORAutoPanel;29 pnlBottom: TPanel; 29 30 btnApply: TButton; 30 31 btnCancel: TButton; … … 209 210 cbxLink: TORComboBox; 210 211 lblLink: TLabel; 212 imgLblTemplates: TVA508ImageListLabeler; 211 213 procedure btnNewClick(Sender: TObject); 212 214 procedure btnApplyClick(Sender: TObject); … … 339 341 Direction, InsertAt: Integer); 340 342 procedure cbxLinkChange(Sender: TObject); 341 procedure cbxLinkSynonymCheck(Sender: TObject; const Text: String;342 var IsSynonym: Boolean);343 343 procedure reBoilKeyUp(Sender: TObject; var Key: Word; 344 344 Shift: TShiftState); … … 346 346 procedure reBoilKeyDown(Sender: TObject; var Key: Word; 347 347 Shift: TShiftState); 348 procedure FormClose(Sender: TObject; var Action: TCloseAction); 348 349 private 349 350 FLastRect: TRect; … … 386 387 FCanDoReminders: boolean; 387 388 FCanDoCOMObjects: boolean; 388 FPersonalObjects: TStringList;389 //FPersonalObjects: TStringList; 389 390 FShowingTemplate: TTemplate; 390 391 FConsultServices: TStringList; … … 416 417 procedure UpdateInsertsDialogs; 417 418 procedure AutoLongLines(Sender: TObject); 418 procedure UpdatePersonalObjects;419 //procedure UpdatePersonalObjects; 419 420 procedure UpdateApply(Template: TTemplate); 420 421 procedure TemplateLocked(Sender: TObject); 421 422 procedure InitTrees; 423 procedure AdjustControls4FontChange; 424 procedure ShowGroupBoilerplate(Visible: boolean); 422 425 function GetLinkType(const ANode: TTreeNode): TTemplateLinkType; 423 426 end; 424 427 425 428 procedure EditTemplates(Form: TForm; NewTemplate: boolean = FALSE; CopiedText: string = ''; Shared: boolean = FALSE); 429 430 const 431 TemplateEditorSplitters = 'frmTempEditSplitters'; 432 TemplateEditorSplitters2 = 'frmTempEditSplitters2'; 433 434 var 435 tmplEditorSplitterMiddle: integer = 0; 436 tmplEditorSplitterProperties: integer = 0; 437 tmplEditorSplitterMain: integer = 0; 438 tmplEditorSplitterBoil: integer = 0; 439 tmplEditorSplitterNotes: integer = 0; 426 440 427 441 implementation … … 431 445 uses dShared, uCore, rTemplates, fTemplateObjects, uSpell, fTemplateView, 432 446 fTemplateAutoGen, fDrawers, fTemplateFieldEditor, fTemplateFields, XMLUtils, 433 fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults; 447 fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults, VAUtils, 448 rMisc, fFindingTemplates; 434 449 435 450 const … … 499 514 Drawers := TFrmDrawers(Form) 500 515 else 501 if IsPublishedProp(Form, 'Drawers') then502 Drawers := TFrmDrawers(GetOrdProp(Form, 'Drawers'));516 if IsPublishedProp(Form, DrawersProperty) then 517 Drawers := TFrmDrawers(GetOrdProp(Form, DrawersProperty)); 503 518 end; 504 519 … … 724 739 725 740 BtnApply.Enabled := BackupDiffers; 741 SetFormPosition(Self); 726 742 end; 727 743 … … 873 889 end; 874 890 lblNotes.Enabled := (not reNotes.ReadOnly); 875 if(reNotes.ReadOnly) then 876 reNotes.Color := ReadOnlyColor 877 else 878 reNotes.Color := clWindow; 891 UpdateReadOnlyColorScheme(reNotes, reNotes.ReadOnly); 879 892 cbxType.Enabled := ok; 880 893 lblType.Enabled := ok; … … 894 907 lblLines.Enabled := ok; 895 908 reBoil.ReadOnly := not ok; 896 if(ok) then 897 reBoil.Color := clWindow 898 else 899 reBoil.Color := ReadOnlyColor; 909 UpdateReadOnlyColorScheme(reBoil, not ok); 900 910 lblLink.Enabled := ok; 901 911 cbxLink.Enabled := ok; … … 937 947 end; 938 948 949 procedure TfrmTemplateEditor.ShowGroupBoilerplate(Visible: boolean); 950 begin 951 pnlGroupBP.Visible := Visible; 952 splBoil.Visible := Visible; 953 if Visible then 954 begin 955 reBoil.Align := alTop; 956 pnlGroupBP.Align := alClient; 957 reBoil.Height := tmplEditorSplitterBoil; 958 splBoil.Top := pnlGroupBP.Top - splBoil.Height; 959 end 960 else 961 begin 962 pnlGroupBP.Align := alBottom; 963 reBoil.Align := alClient; 964 end; 965 end; 966 939 967 procedure TfrmTemplateEditor.ShowInfo(Node: TTreeNode); 940 968 var … … 942 970 Idx: TTypeIndex; 943 971 CanDoCOM: boolean; 944 LinkTemplate: TTemplate;945 972 lt: TTemplateLinkType; 946 973 lts: string; 947 i: integer;948 974 949 975 begin … … 980 1006 begin 981 1007 FConsultServices := TStringList.Create; 982 F ConsultServices.Assign(LoadServiceListWithSynonyms(1));1008 FastAssign(LoadServiceListWithSynonyms(1), FConsultServices); 983 1009 SortByPiece(FConsultServices, U, 2); 984 1010 end; 985 for i := 0 to FConsultServices.Count-1 do 986 begin 987 LinkTemplate := GetLinkedTemplate(piece(FConsultServices[i],U,1), ltConsult); 988 if (not assigned(LinkTemplate)) or (LinkTemplate = FShowingTemplate) then 989 cbxLink.Items.Add(FConsultServices[i]); 990 end; 1011 FastAssign(FConsultServices, cbxLink.Items); 991 1012 end 992 1013 else … … 1171 1192 edtGap.Text := '0'; 1172 1193 reBoil.Clear; 1173 pnlGroupBP.Visible := FALSE; 1174 splBoil.Visible := FALSE; 1194 ShowGroupBoilerplate(False); 1175 1195 pnlBoilerplateResize(Self); 1176 1196 pnlCOM.Visible := FALSE; … … 1196 1216 begin 1197 1217 if(pnlGroupBP.Visible) and (pnlGroupBP.Height > (pnlBoilerplate.Height-29)) then 1218 begin 1198 1219 pnlGroupBP.Height := pnlBoilerplate.Height-29; 1220 end; 1199 1221 if cbLongLines.checked then 1200 1222 Max := 240 … … 1449 1471 begin 1450 1472 reBoil.ReadOnly := TRUE; 1451 reBoil.Color := ReadOnlyColor;1473 UpdateReadOnlyColorScheme(reBoil, TRUE); 1452 1474 UpdateInsertsDialogs; 1453 1475 end; 1454 pnlGroupBP.Visible := ItemOK; 1455 splBoil.Visible := ItemOK; 1476 ShowGroupBoilerplate(ItemOK); 1456 1477 if(not ItemOK) and (IsReminderDialog or IsCOMObject) then 1457 1478 BPOK := FALSE; 1458 if(ItemOK) then1459 splBoil.Top := pnlGroupBP.Top - splBoil.Height;1460 1479 pnlBoilerplateResize(Self); 1461 1480 pnlBoilerplate.Visible := BPOK; … … 1482 1501 frmTemplateFields := nil; 1483 1502 end; 1484 KillObj(@FPersonalObjects); 1503 //---------- CQ #8665 - RV -------- 1504 //KillObj(@FPersonalObjects); 1505 if (assigned(uPersonalObjects)) then 1506 begin 1507 KillObj(@uPersonalObjects); 1508 uPersonalObjects.Free; 1509 uPersonalObjects := nil; 1510 end; 1511 // ---- end CQ #8665 ------------- 1485 1512 dmodShared.OnTemplateLock := nil; 1486 1513 dmodShared.InEditor := FALSE; … … 2040 2067 end; 2041 2068 2069 procedure TfrmTemplateEditor.AdjustControls4FontChange; 2070 var 2071 x: integer; 2072 2073 procedure Adjust(Control: TWinControl); 2074 begin 2075 x := x - Control.Width - 2; 2076 Control.Left := x; 2077 end; 2078 2079 begin 2080 if FCanEditShared then 2081 begin 2082 x := pnlSharedBottom.Width; 2083 Adjust(sbSHDelete); 2084 Adjust(sbSHDown); 2085 Adjust(sbSHUp); 2086 cbSHHide.Width := x; 2087 end; 2088 x := pnlBottom.Width; 2089 Adjust(btnApply); 2090 Adjust(btnCancel); 2091 Adjust(btnOK); 2092 cbEditShared.Width := TextWidthByFont(cbEditShared.Font.Handle, cbEditShared.Caption) + 25; 2093 cbNotes.Left := cbEditShared.Left + cbEditShared.Width + 60; 2094 cbNotes.Width := TextWidthByFont(cbNotes.Font.Handle, cbNotes.Caption) + 25; 2095 end; 2096 2042 2097 function TfrmTemplateEditor.AllowMove(ADropNode, ADragNode: TTreeNode): boolean; 2043 2098 var … … 2205 2260 MoveCopyButtons; 2206 2261 tvTreeChange(FCurTree, FCurTree.Selected); 2262 if FCanEditShared then 2263 AdjustControls4FontChange; 2207 2264 end; 2208 2265 … … 2327 2384 procedure TfrmTemplateEditor.btnFindClick(Sender: TObject); 2328 2385 var 2329 Found: boolean;2386 Found: TTreeNode; 2330 2387 edtSearch: TEdit; 2388 IsNext: boolean; 2331 2389 FindNext: boolean; 2332 2390 FindWholeWords: boolean; … … 2334 2392 Tree: TTreeView; 2335 2393 LastFoundNode, TmpNode: TTreeNode; 2336 S1,S2: string;2394 // S1,S2: string; 2337 2395 2338 2396 begin … … 2345 2403 FindCase := cbShMatchCase.Checked; 2346 2404 LastFoundNode := FLastFoundShNode; 2347 if(FSharedEmptyNodeCount > 0) then2348 begin2349 FInternalHiddenExpand := TRUE;2350 try2351 tvShared.Items.GetFirstNode.Expand(TRUE);2352 finally2353 FInternalHiddenExpand := FALSE;2354 end;2355 end;2356 2405 end 2357 2406 else … … 2363 2412 FindCase := cbPerMatchCase.Checked; 2364 2413 LastFoundNode := FLastFoundPerNode; 2365 if(FPersonalEmptyNodeCount > 0) then2366 begin2367 FInternalHiddenExpand := TRUE;2368 try2369 tvPersonal.Items.GetFirstNode.Expand(TRUE);2370 finally2371 FInternalHiddenExpand := FALSE;2372 end;2373 end;2374 2414 end; 2375 2415 if(edtSearch.text <> '') then 2376 2416 begin 2377 if((FindNext) and assigned (LastFoundNode)) then 2378 TmpNode := LastFoundNode.GetNext 2417 IsNext := ((FindNext) and assigned (LastFoundNode)); 2418 if IsNext then 2419 2420 TmpNode := LastFoundNode 2379 2421 else 2380 2422 TmpNode := Tree.Items.GetFirstNode; 2381 Found := FALSE; 2382 if(assigned(TmpNode)) then 2383 begin 2384 S1 := edtSearch.Text; 2385 if(not FindCase) then 2386 S1 := UpperCase(S1); 2387 while (assigned(TmpNode) and (not Found)) do 2388 begin 2389 S2 := TmpNode.Text; 2390 if(not FindCase) then 2391 S2 := UpperCase(S2); 2392 Found := SearchMatch(S1, S2, FindWholeWords); 2393 if(not Found) then 2394 TmpNode := TmpNode.GetNext; 2395 end; 2396 end; 2397 if(Found) then 2398 begin 2423 FInternalHiddenExpand := TRUE; 2424 try 2425 Found := FindTemplate(edtSearch.Text, Tree, Self, TmpNode, 2426 IsNext, not FindCase, FindWholeWords); 2427 finally 2428 FInternalHiddenExpand := FALSE; 2429 end; 2430 if Assigned(Found) then 2431 begin 2432 Tree.Selected := Found; 2399 2433 if(Tree = tvShared) then 2400 FLastFoundShNode := TmpNode2434 FLastFoundShNode := Found 2401 2435 else 2402 FLastFoundPerNode := TmpNode;2436 FLastFoundPerNode := Found; 2403 2437 SetFindNext(Tree, TRUE); 2404 Tree.Selected := TmpNode;2405 end2406 else2407 begin2408 if(FindNext) then2409 S1 := ''2410 else2411 S1 := ' "' + edtSearch.Text + '" was not Found.';2412 SetFindNext(Tree, FALSE);2413 InfoBox('Search Complete.' + S1, 'Information', MB_OK or MB_ICONINFORMATION);2414 2438 end; 2415 2439 end; … … 2499 2523 end; 2500 2524 pnlBoilerplateResize(Self); 2525 AdjustControls4FontChange; 2526 MoveCopyButtons; 2501 2527 end; 2502 2528 end; … … 2516 2542 begin 2517 2543 UpdatePersonalObjects; 2518 if FPersonalObjects.Count > 0 then2544 if uPersonalObjects.Count > 0 then // -------- CQ #8665 - RV ------------ 2519 2545 begin 2520 2546 DoIt := FALSE; 2521 2547 for i := 0 to dmodShared.TIUObjects.Count-1 do 2522 if FPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then2548 if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then // -------- CQ #8665 - RV ------------ 2523 2549 frmTemplateObjects.cboObjects.Items.Add(dmodShared.TIUObjects[i]); 2524 2550 end; 2525 2551 end; 2526 2552 if DoIt then 2527 frmTemplateObjects.cboObjects.Items.Assign(dmodShared.TIUObjects);2553 FastAssign(dmodShared.TIUObjects, frmTemplateObjects.cboObjects.Items); 2528 2554 frmTemplateObjects.Font := Font; 2529 2555 frmTemplateObjects.re := reBoil; … … 2633 2659 end; 2634 2660 2661 procedure TfrmTemplateEditor.FormClose(Sender: TObject; 2662 var Action: TCloseAction); 2663 begin 2664 SaveUserBounds(Self); 2665 end; 2666 2635 2667 procedure TfrmTemplateEditor.FormCloseQuery(Sender: TObject; 2636 2668 var CanClose: Boolean); … … 2666 2698 procedure TfrmTemplateEditor.splBoilMoved(Sender: TObject); 2667 2699 begin 2700 if pnlBoilerplate.Visible and pnlGroupBP.Visible then 2701 tmplEditorSplitterBoil := reBoil.Height; 2702 if pnlNotes.Visible then 2703 tmplEditorSplitterNotes := pnlNotes.Height; 2668 2704 pnlBoilerplateResize(Self); 2669 2705 end; … … 3105 3141 procedure TfrmTemplateEditor.mbMainResize(Sender: TObject); 3106 3142 begin 3107 pnlMenu.Width := mbMain.Width + 3; 3143 pnlMenu.Width := mbMain.Width + 4; 3144 mbMain.Width := pnlMenu.Width - 3; 3108 3145 end; 3109 3146 … … 3179 3216 dmodShared.LoadTIUObjects; 3180 3217 UpdatePersonalObjects; 3181 GetAutoGenText(AName, AText, FPersonalObjects);3218 GetAutoGenText(AName, AText, uPersonalObjects); // -------- CQ #8665 - RV ------------ 3182 3219 if(AName <> '') and (AText <> '') then 3183 3220 begin … … 3274 3311 pnlNotes.Visible := cbNotes.Checked; 3275 3312 splNotes.Visible := cbNotes.Checked; 3276 splNotes.Top := pnlNotes.Top-3; 3313 if cbNotes.Checked then 3314 begin 3315 pnlNotes.Height := tmplEditorSplitterNotes; 3316 pnlNotes.Top := pnlBottom.Top - pnlNotes.Height; 3317 splNotes.Top := pnlNotes.Top-3; 3318 end; 3277 3319 pnlBoilerplateResize(Self); 3278 3320 end; … … 3397 3439 if (Flds.Count > 0) then begin 3398 3440 ExpandEmbeddedFields(Flds); 3399 F lds.Assign(ExportTemplateFields(Flds));3441 FastAssign(ExportTemplateFields(Flds), Flds); 3400 3442 for i := 0 to Flds.Count-1 do 3401 3443 Flds[i] := ' ' + Flds[i]; 3402 Tmpl.AddStrings(Flds);3444 FastAddStrings(Flds, Tmpl); 3403 3445 end; {if} 3404 3446 Tmpl.Add('</'+XMLHeader+'>'); … … 3704 3746 FUpdating := FALSE; 3705 3747 end; 3706 ShowM essage('Can not assign a Reminder Dialog to a Reason for Request');3748 ShowMsg('Can not assign a Reminder Dialog to a Reason for Request'); 3707 3749 end 3708 3750 else … … 3790 3832 end; 3791 3833 3792 procedure TfrmTemplateEditor.UpdatePersonalObjects;3834 (*procedure TfrmTemplateEditor.UpdatePersonalObjects; 3793 3835 var 3794 3836 i: integer; … … 3803 3845 FPersonalObjects.Sorted := TRUE; 3804 3846 end; 3805 end; 3847 end;*) 3806 3848 3807 3849 (*function TfrmTemplateEditor.ModifyAllowed(const Node: TTreeNode): boolean; … … 3875 3917 begin 3876 3918 Resync([TTemplate(Sender)]); 3877 ShowM essage(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));3919 ShowMsg(Format(TemplateLockedText, [TTemplate(Sender).PrintName])); 3878 3920 end; 3879 3921 … … 4074 4116 try 4075 4117 case TTemplateLinkType(pnlLink.Tag) of 4076 ltTitle: tmpSL.Assign(SubSetOfAllTitles(StartFrom, Direction));4118 ltTitle: FastAssign(SubSetOfAllTitles(StartFrom, Direction), tmpSL); 4077 4119 // ltConsult: 4078 4120 ltProcedure: 4079 4121 begin 4080 tmpSL.Assign(SubSetOfProcedures(StartFrom, Direction));4122 FastAssign(SubSetOfProcedures(StartFrom, Direction), tmpSL); 4081 4123 for i := 0 to tmpSL.Count-1 do 4082 4124 begin … … 4096 4138 var 4097 4139 Template,LinkTemplate: TTemplate; 4140 update: boolean; 4098 4141 4099 4142 begin … … 4104 4147 if assigned(Template) and Template.CanModify then 4105 4148 begin 4149 update := true; 4106 4150 if cbxLink.ItemIEN > 0 then 4107 4151 begin … … 4109 4153 if (assigned(LinkTemplate) and (LinkTemplate <> Template)) then 4110 4154 begin 4111 ShowM essage(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +4155 ShowMsg(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) + 4112 4156 ' is already assigned to another template.'); 4113 cbxLink.ItemIndex := -1; 4157 cbxLink.SelectByID(Template.LinkIEN); 4158 update := False; 4159 end 4160 else 4161 begin 4162 Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)); 4163 if Template.LinkName <> '' then 4164 edtName.Text := copy(Template.LinkName,1,edtName.MaxLength); 4114 4165 end; 4115 Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));4116 if Template.LinkName <> '' then4117 edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);4118 4166 end 4119 4167 else 4120 4168 Template.FileLink := ''; 4121 UpdateApply(Template); 4122 end; 4123 end; 4124 end; 4125 4126 procedure TfrmTemplateEditor.cbxLinkSynonymCheck(Sender: TObject; 4127 const Text: String; var IsSynonym: Boolean); 4128 var 4129 LinkTemplate: TTemplate; 4130 var IEN: string; 4131 4132 begin 4133 IsSynonym := FALSE; 4134 if pnlLink.Visible and assigned(FShowingTemplate) then 4135 begin 4136 IEN := Piece(Text,#9,30); 4137 if IEN <> '' then 4138 begin 4139 LinkTemplate := GetLinkedTemplate(IEN, TTemplateLinkType(pnlLink.Tag)); 4140 IsSynonym := (assigned(LinkTemplate) and (LinkTemplate <> FShowingTemplate)); 4141 end 4142 else 4143 IsSynonym := FALSE; 4169 if update then 4170 UpdateApply(Template); 4171 end; 4144 4172 end; 4145 4173 end; -
cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.dfm
r456 r829 1 objectfrmTemplateFieldEditor: TfrmTemplateFieldEditor1 inherited frmTemplateFieldEditor: TfrmTemplateFieldEditor 2 2 Left = 294 3 3 Top = 211 4 Width = 6405 Height = 4476 4 BorderIcons = [biSystemMenu, biMaximize] 7 5 Caption = 'Template Field Editor' 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 = False 6 ClientHeight = 420 7 ClientWidth = 788 15 8 Position = poScreenCenter 16 9 OnCloseQuery = FormCloseQuery … … 18 11 OnDestroy = FormDestroy 19 12 OnResize = FormResize 13 ExplicitWidth = 796 14 ExplicitHeight = 454 20 15 PixelsPerInch = 96 21 16 TextHeight = 13 22 object splLeft: TSplitter 23 Left = 27317 object splLeft: TSplitter [0] 18 Left = 429 24 19 Top = 25 25 Width = 326 20 Height = 366 27 Cursor = crHSplit28 21 Beveled = True 22 ExplicitLeft = 273 29 23 end 30 object pnlBottom: TPanel 24 object pnlBottom: TPanel [1] 31 25 Left = 0 32 26 Top = 391 33 Width = 63227 Width = 788 34 28 Height = 29 35 29 Align = alBottom 36 30 TabOrder = 2 37 31 DesignSize = ( 38 63232 788 39 33 29) 40 34 object lblReq: TStaticText … … 47 41 end 48 42 object btnOK: TButton 49 Left = 39243 Left = 548 50 44 Top = 4 51 45 Width = 75 … … 58 52 end 59 53 object btnCancel: TButton 60 Left = 47254 Left = 628 61 55 Top = 4 62 56 Width = 75 … … 70 64 end 71 65 object btnApply: TButton 72 Left = 55266 Left = 708 73 67 Top = 4 74 68 Width = 75 … … 80 74 end 81 75 object btnPreview: TButton 82 Left = 27976 Left = 435 83 77 Top = 4 84 78 Width = 75 … … 102 96 end 103 97 end 104 object pnlObjs: TPanel 98 object pnlObjs: TPanel [2] 105 99 Left = 0 106 100 Top = 25 107 Width = 273101 Width = 429 108 102 Height = 366 109 103 Align = alLeft … … 114 108 Left = 1 115 109 Top = 1 116 Width = 271110 Width = 427 117 111 Height = 13 118 112 Align = alTop 119 113 Caption = 'Template Fields' 114 ExplicitWidth = 74 120 115 end 121 116 object cbxObjs: TORComboBox 122 117 Left = 1 123 118 Top = 14 124 Width = 271119 Width = 427 125 120 Height = 351 126 121 Style = orcsSimple … … 141 136 Sorted = False 142 137 SynonymChars = '<Inactive>' 143 TabPositions = ' 34,45,55,65,75'138 TabPositions = '50,60,70,80,90' 144 139 TabOrder = 0 145 140 OnChange = cbxObjsChange … … 147 142 OnNeedData = cbxObjsNeedData 148 143 OnSynonymCheck = cbxObjsSynonymCheck 144 CharsNeedMatch = 1 149 145 end 150 146 end 151 object pnlRight: TPanel 152 Left = 276147 object pnlRight: TPanel [3] 148 Left = 432 153 149 Top = 25 154 150 Width = 356 … … 182 178 Align = alTop 183 179 Caption = 'Notes:' 180 ExplicitWidth = 31 184 181 end 185 182 object reNotes: TRichEdit … … 370 367 TabOrder = 1 371 368 OnChange = cbxTypeChange 369 CharsNeedMatch = 1 372 370 end 373 371 object edtTextLen: TCaptionEdit … … 389 387 Anchors = [akTop, akRight] 390 388 Associate = edtTextLen 391 Min = 0392 389 Max = 240 393 Position = 0394 390 TabOrder = 5 395 Wrap = False396 391 end 397 392 object pnlSwap: TPanel … … 408 403 Width = 300 409 404 Height = 22 405 Align = alTop 410 406 Font.Charset = ANSI_CHARSET 411 407 Font.Color = clWindowText … … 420 416 OnEnter = edtpopControlEnter 421 417 OnExit = ControlExit 422 Align = alTop423 418 Caption = 'Default Value' 424 419 end … … 460 455 Min = -9999 461 456 Max = 9999 462 Position = 0463 457 TabOrder = 1 464 458 Thousands = False 465 Wrap = False466 459 end 467 460 object edtDefNum: TCaptionEdit … … 483 476 Min = -9999 484 477 Max = 9999 485 Position = 0486 478 TabOrder = 3 487 479 Thousands = False 488 Wrap = False489 480 end 490 481 object edtMinVal: TCaptionEdit … … 508 499 Position = 1 509 500 TabOrder = 7 510 Wrap = False511 501 end 512 502 object edtInc: TCaptionEdit … … 538 528 Min = -9999 539 529 Max = 9999 540 Position = 0541 530 TabOrder = 5 542 531 Thousands = False 543 Wrap = False544 532 end 545 533 end … … 549 537 Width = 300 550 538 Height = 22 539 Align = alTop 551 540 Font.Charset = ANSI_CHARSET 552 541 Font.Color = clWindowText … … 560 549 OnChange = edtURLChange 561 550 OnEnter = edtpopControlEnter 562 Align = alTop563 551 Caption = 'URL' 564 552 end … … 615 603 TabStop = True 616 604 OnChange = cbxDefaultChange 605 CharsNeedMatch = 1 617 606 end 618 607 object pnlDate: TPanel … … 678 667 TabOrder = 1 679 668 OnChange = cbxDateTypeChange 669 CharsNeedMatch = 1 680 670 end 681 671 end … … 703 693 Position = 1 704 694 TabOrder = 3 705 Wrap = False706 695 end 707 696 object gbIndent: TGroupBox … … 743 732 Height = 21 744 733 Associate = edtIndent 745 Min = 0746 734 Max = 30 747 Position = 0748 735 TabOrder = 1 749 736 Thousands = False 750 Wrap = False751 737 end 752 738 object udPad: TUpDown … … 756 742 Height = 21 757 743 Associate = edtPad 758 Min = 0759 744 Max = 30 760 Position = 0761 745 TabOrder = 2 762 746 Thousands = False 763 Wrap = False764 747 end 765 748 object edtPad: TCaptionEdit … … 823 806 end 824 807 end 825 object pnlTop: TPanel 808 object pnlTop: TPanel [4] 826 809 Left = 0 827 810 Top = 0 828 Width = 632811 Width = 788 829 812 Height = 25 830 813 Align = alTop … … 832 815 TabOrder = 3 833 816 DesignSize = ( 834 632817 788 835 818 25) 836 819 object MenuBar1: TMenuBar 837 820 Left = 0 838 821 Top = 0 839 Width = 23822 Width = 41 840 823 Height = 25 841 824 Align = alLeft … … 844 827 ButtonWidth = 43 845 828 Caption = 'MenuBar1' 846 Flat = True847 829 Menu = mnuMain 848 830 ShowCaptions = True … … 850 832 end 851 833 object btnNew: TButton 852 Left = 557834 Left = 711 853 835 Top = 2 854 836 Width = 75 … … 860 842 end 861 843 object btnCopy: TButton 862 Left = 478844 Left = 632 863 845 Top = 2 864 846 Width = 75 … … 871 853 end 872 854 object btnDelete: TButton 873 Left = 399855 Left = 553 874 856 Top = 2 875 857 Width = 75 … … 881 863 OnClick = mnuDeleteClick 882 864 end 865 end 866 inherited amgrMain: TVA508AccessibilityManager 867 Data = ( 868 ( 869 'Component = pnlBottom' 870 'Status = stsDefault') 871 ( 872 'Component = lblReq' 873 'Status = stsDefault') 874 ( 875 'Component = btnOK' 876 'Status = stsDefault') 877 ( 878 'Component = btnCancel' 879 'Status = stsDefault') 880 ( 881 'Component = btnApply' 882 'Status = stsDefault') 883 ( 884 'Component = btnPreview' 885 'Status = stsDefault') 886 ( 887 'Component = cbHide' 888 'Status = stsDefault') 889 ( 890 'Component = pnlObjs' 891 'Status = stsDefault') 892 ( 893 'Component = cbxObjs' 894 'Status = stsDefault') 895 ( 896 'Component = pnlRight' 897 'Status = stsDefault') 898 ( 899 'Component = pnlPreview' 900 'Status = stsDefault') 901 ( 902 'Component = reNotes' 903 'Status = stsDefault') 904 ( 905 'Component = pnlObjInfo' 906 'Status = stsDefault') 907 ( 908 'Component = edtName' 909 'Status = stsDefault') 910 ( 911 'Component = edtLMText' 912 'Status = stsDefault') 913 ( 914 'Component = cbxType' 915 'Status = stsDefault') 916 ( 917 'Component = edtTextLen' 918 'Status = stsDefault') 919 ( 920 'Component = udTextLen' 921 'Status = stsDefault') 922 ( 923 'Component = pnlSwap' 924 'Status = stsDefault') 925 ( 926 'Component = edtDefault' 927 'Status = stsDefault') 928 ( 929 'Component = pnlNum' 930 'Status = stsDefault') 931 ( 932 'Component = udDefNum' 933 'Status = stsDefault') 934 ( 935 'Component = edtDefNum' 936 'Status = stsDefault') 937 ( 938 'Component = udMinVal' 939 'Status = stsDefault') 940 ( 941 'Component = edtMinVal' 942 'Status = stsDefault') 943 ( 944 'Component = udInc' 945 'Status = stsDefault') 946 ( 947 'Component = edtInc' 948 'Status = stsDefault') 949 ( 950 'Component = edtMaxVal' 951 'Status = stsDefault') 952 ( 953 'Component = udMaxVal' 954 'Status = stsDefault') 955 ( 956 'Component = edtURL' 957 'Status = stsDefault') 958 ( 959 'Component = reItems' 960 'Status = stsDefault') 961 ( 962 'Component = cbxDefault' 963 'Status = stsDefault') 964 ( 965 'Component = pnlDate' 966 'Status = stsDefault') 967 ( 968 'Component = edtDateDef' 969 'Status = stsDefault') 970 ( 971 'Component = cbxDateType' 972 'Status = stsDefault') 973 ( 974 'Component = edtLen' 975 'Status = stsDefault') 976 ( 977 'Component = udLen' 978 'Status = stsDefault') 979 ( 980 'Component = gbIndent' 981 'Status = stsDefault') 982 ( 983 'Component = edtIndent' 984 'Status = stsDefault') 985 ( 986 'Component = udIndent' 987 'Status = stsDefault') 988 ( 989 'Component = udPad' 990 'Status = stsDefault') 991 ( 992 'Component = edtPad' 993 'Status = stsDefault') 994 ( 995 'Component = gbMisc' 996 'Status = stsDefault') 997 ( 998 'Component = cbActive' 999 'Status = stsDefault') 1000 ( 1001 'Component = cbRequired' 1002 'Status = stsDefault') 1003 ( 1004 'Component = cbSepLines' 1005 'Status = stsDefault') 1006 ( 1007 'Component = cbExclude' 1008 'Status = stsDefault') 1009 ( 1010 'Component = pnlTop' 1011 'Status = stsDefault') 1012 ( 1013 'Component = MenuBar1' 1014 'Status = stsDefault') 1015 ( 1016 'Component = btnNew' 1017 'Status = stsDefault') 1018 ( 1019 'Component = btnCopy' 1020 'Status = stsDefault') 1021 ( 1022 'Component = btnDelete' 1023 'Status = stsDefault') 1024 ( 1025 'Component = frmTemplateFieldEditor' 1026 'Status = stsDefault')) 883 1027 end 884 1028 object mnuMain: TMainMenu -
cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.pas
r456 r829 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 7 ORCtrls, StdCtrls, ExtCtrls, Menus, ComCtrls, uTemplateFields, ORFn, 8 ToolWin, MenuBar, ORClasses, ORDtTm ;8 ToolWin, MenuBar, ORClasses, ORDtTm, fBase508Form, VA508AccessibilityManager; 9 9 10 10 type 11 TfrmTemplateFieldEditor = class(T Form)11 TfrmTemplateFieldEditor = class(TfrmBase508Form) 12 12 pnlBottom: TPanel; 13 13 btnOK: TButton; … … 184 184 185 185 uses rTemplates, fTemplateDialog, Clipbrd, uSpell, uConst, 186 fTemplateFields ;186 fTemplateFields, VAUtils; 187 187 188 188 {$R *.DFM} … … 470 470 FUpdating := TRUE; 471 471 try 472 cbxDefault.Items.Assign(reItems.Lines);472 QuickCopy(reItems, cbxDefault); 473 473 idx := -1; 474 474 if(assigned(FFld)) and reItems.Visible and cbxDefault.Visible then … … 509 509 tmp := TORStringList.Create; 510 510 try 511 tmp.Assign(SubSetOfTemplateFields(StartFrom, Direction));511 FastAssign(SubSetOfTemplateFields(StartFrom, Direction), tmp); 512 512 for i := 0 to FDeleted.Count-1 do 513 513 begin … … 516 516 tmp.delete(idx); 517 517 end; 518 ConvertCodes2Text(tmp, TRUE);518 ConvertCodes2Text(tmp, FALSE); 519 519 cbxObjs.ForDataUse(tmp); 520 520 finally … … 815 815 if FDeleted.IndexOfPiece(FFld.FldName, U, 2) >= 0 then 816 816 begin 817 ShowM essage('Template field can not be named the same as a deleted' + CRLF +817 ShowMsg('Template field can not be named the same as a deleted' + CRLF + 818 818 'field until OK or Apply has been pressed.'); 819 819 bad := TRUE; -
cprs/trunk/CPRS-Chart/Templates/fTemplateFields.dfm
r456 r829 1 objectfrmTemplateFields: TfrmTemplateFields1 inherited frmTemplateFields: TfrmTemplateFields 2 2 Left = 212 3 3 Top = 155 4 Width = 4185 Height = 3006 4 Caption = 'Insert Template Field' 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 = [] 5 ClientHeight = 319 6 ClientWidth = 450 13 7 FormStyle = fsStayOnTop 14 OldCreateOrder = False15 8 Position = poOwnerFormCenter 16 9 OnClose = FormClose 17 10 OnCreate = FormCreate 18 11 OnShow = FormShow 12 ExplicitWidth = 458 13 ExplicitHeight = 346 19 14 PixelsPerInch = 96 20 15 TextHeight = 13 21 object pnlBottom: TPanel 16 object pnlBottom: TPanel [0] 22 17 Left = 0 23 Top = 2 4624 Width = 4 1025 Height = 2 718 Top = 226 19 Width = 450 20 Height = 28 26 21 Align = alBottom 27 22 BevelOuter = bvNone 28 TabOrder = 023 TabOrder = 1 29 24 DesignSize = ( 30 410 31 27) 32 object lblReq: TStaticText 33 Left = 21 34 Top = 8 35 Width = 134 36 Height = 17 37 Caption = '* Indicates a Required Field' 38 TabOrder = 3 39 end 25 450 26 28) 40 27 object btnCancel: TButton 41 Left = 3 3528 Left = 371 42 29 Top = 4 43 30 Width = 75 … … 47 34 Caption = '&Done' 48 35 ModalResult = 2 49 TabOrder = 236 TabOrder = 3 50 37 OnClick = btnCancelClick 51 38 end 52 39 object btnInsert: TButton 53 Left = 2 5540 Left = 291 54 41 Top = 4 55 42 Width = 75 … … 59 46 Default = True 60 47 ModalResult = 4 61 TabOrder = 148 TabOrder = 2 62 49 OnClick = btnInsertClick 63 50 end 64 51 object btnPreview: TButton 65 Left = 17552 Left = 211 66 53 Top = 4 67 54 Width = 75 68 55 Height = 21 56 Anchors = [akTop, akRight] 69 57 Caption = '&Preview' 70 58 Enabled = False 59 TabOrder = 1 60 OnClick = btnPreviewClick 61 end 62 object lblReq: TVA508StaticText 63 Name = 'lblReq' 64 AlignWithMargins = True 65 Left = 10 66 Top = 12 67 Width = 132 68 Height = 15 69 Alignment = taLeftJustify 70 Anchors = [akLeft, akBottom] 71 Caption = '* Indicates a Required Field' 71 72 TabOrder = 0 72 OnClick = btnPreviewClick73 end 74 end 75 object cboObjects: TORComboBox 73 ShowAccelChar = True 74 end 75 end 76 object cboObjects: TORComboBox [1] 76 77 Left = 0 77 78 Top = 0 78 Width = 4 1079 Height = 2 4679 Width = 450 80 Height = 226 80 81 Style = orcsSimple 81 82 Align = alClient … … 89 90 ListItemsOnly = True 90 91 LongList = True 92 LookupPiece = 0 91 93 MaxLength = 0 92 94 Pieces = '2,3' … … 95 97 SynonymChars = '<Inactive>' 96 98 TabPositions = '50,60,70,80,90' 97 TabOrder = 1 99 TabOrder = 0 100 TabStop = True 98 101 OnChange = cboObjectsChange 99 102 OnDblClick = cboObjectsDblClick 100 103 OnNeedData = cboObjectsNeedData 104 CharsNeedMatch = 1 105 end 106 object pnlBottomSR: TPanel [2] 107 Left = 0 108 Top = 254 109 Width = 450 110 Height = 65 111 Align = alBottom 112 BevelOuter = bvNone 113 TabOrder = 2 114 object lblSRCont2: TVA508StaticText 115 Name = 'lblSRCont2' 116 AlignWithMargins = True 117 Left = 24 118 Top = 45 119 Width = 423 120 Height = 15 121 Margins.Left = 24 122 Margins.Top = 0 123 Margins.Bottom = 0 124 Align = alTop 125 Alignment = taLeftJustify 126 Caption = 127 'speaking text that follows the template field, when the field re' + 128 'ceives focus.' 129 TabOrder = 3 130 ShowAccelChar = True 131 end 132 object lblSRCont1: TVA508StaticText 133 Name = 'lblSRCont1' 134 AlignWithMargins = True 135 Left = 10 136 Top = 30 137 Width = 437 138 Height = 15 139 Margins.Left = 10 140 Margins.Top = 0 141 Margins.Bottom = 0 142 Align = alTop 143 Alignment = taLeftJustify 144 Caption = 145 '*** Place this code after a template field to allow the screen r' + 146 'eader to continue' 147 TabOrder = 2 148 ShowAccelChar = True 149 end 150 object lblSRStop: TVA508StaticText 151 Name = 'lblSRStop' 152 AlignWithMargins = True 153 Left = 10 154 Top = 15 155 Width = 437 156 Height = 15 157 Margins.Left = 10 158 Margins.Top = 0 159 Margins.Bottom = 0 160 Align = alTop 161 Alignment = taLeftJustify 162 Caption = '** Screen reader will stop speaking at this point' 163 TabOrder = 1 164 ShowAccelChar = True 165 end 166 object pnlSRIntro: TPanel 167 Left = 0 168 Top = 0 169 Width = 450 170 Height = 15 171 Align = alTop 172 BevelOuter = bvNone 173 TabOrder = 0 174 object lblSRIntro1: TVA508StaticText 175 Name = 'lblSRIntro1' 176 AlignWithMargins = True 177 Left = 10 178 Top = 0 179 Width = 127 180 Height = 15 181 Margins.Left = 10 182 Margins.Top = 0 183 Margins.Bottom = 0 184 Align = alLeft 185 Alignment = taLeftJustify 186 Caption = 'Screen Reader Codes' 187 Font.Charset = DEFAULT_CHARSET 188 Font.Color = clWindowText 189 Font.Height = -11 190 Font.Name = 'MS Sans Serif' 191 Font.Style = [fsBold] 192 ParentFont = False 193 TabOrder = 0 194 ShowAccelChar = True 195 end 196 object lblSRIntro2: TVA508StaticText 197 Name = 'lblSRIntro2' 198 Left = 140 199 Top = 0 200 Width = 310 201 Height = 15 202 Align = alClient 203 Alignment = taLeftJustify 204 Caption = '(make templates user friendly for those using screen readers)' 205 TabOrder = 1 206 ShowAccelChar = True 207 end 208 end 209 end 210 inherited amgrMain: TVA508AccessibilityManager 211 Data = ( 212 ( 213 'Component = pnlBottom' 214 'Status = stsDefault') 215 ( 216 'Component = btnCancel' 217 'Status = stsDefault') 218 ( 219 'Component = btnInsert' 220 'Status = stsDefault') 221 ( 222 'Component = btnPreview' 223 'Status = stsDefault') 224 ( 225 'Component = cboObjects' 226 'Status = stsDefault') 227 ( 228 'Component = frmTemplateFields' 229 'Status = stsDefault') 230 ( 231 'Component = lblReq' 232 'Status = stsDefault') 233 ( 234 'Component = pnlBottomSR' 235 'Status = stsDefault') 236 ( 237 'Component = lblSRCont2' 238 'Status = stsDefault') 239 ( 240 'Component = lblSRCont1' 241 'Status = stsDefault') 242 ( 243 'Component = lblSRStop' 244 'Status = stsDefault') 245 ( 246 'Component = pnlSRIntro' 247 'Status = stsDefault') 248 ( 249 'Component = lblSRIntro1' 250 'Status = stsDefault') 251 ( 252 'Component = lblSRIntro2' 253 'Status = stsDefault')) 101 254 end 102 255 end -
cprs/trunk/CPRS-Chart/Templates/fTemplateFields.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ORCtrls, ComCtrls, StdCtrls, ExtCtrls ;7 ORCtrls, ComCtrls, StdCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmTemplateFields = class(T Form)10 TfrmTemplateFields = class(TfrmBase508Form) 11 11 pnlBottom: TPanel; 12 12 btnCancel: TButton; 13 13 cboObjects: TORComboBox; 14 14 btnInsert: TButton; 15 lblReq: TStaticText;16 15 btnPreview: TButton; 16 lblReq: TVA508StaticText; 17 pnlBottomSR: TPanel; 18 lblSRCont2: TVA508StaticText; 19 lblSRCont1: TVA508StaticText; 20 lblSRStop: TVA508StaticText; 21 pnlSRIntro: TPanel; 22 lblSRIntro1: TVA508StaticText; 23 lblSRIntro2: TVA508StaticText; 17 24 procedure FormShow(Sender: TObject); 18 25 procedure FormCreate(Sender: TObject); … … 28 35 { Fre: TRichEdit;} 29 36 Fre: TCustomEdit; 37 FInsertAllowed: boolean; 38 FInitialized: boolean; 30 39 FAutoLongLines: TNotifyEvent; 31 40 procedure InsertField; 32 41 { procedure Setre(const Value: TRichEdit);} 33 42 procedure Setre(const Value: TCustomEdit); 43 function ValidPreview: boolean; 44 function ValidInsert: boolean; 34 45 public 35 46 procedure UpdateStatus; … … 47 58 48 59 procedure TfrmTemplateFields.FormShow(Sender: TObject); 49 begin 60 var 61 i: integer; 62 begin 63 if not FInitialized then 64 begin 65 with cboObjects do 66 begin 67 for i := low(ScreenReaderCodeLines) to high(ScreenReaderCodeLines) do 68 Items.Add(ScreenReaderCodeLines[i]); 69 InsertSeparator; 70 InitLongList(''); 71 end; 72 FInitialized := TRUE; 73 end; 50 74 cboObjects.SelectAll; 51 75 cboObjects.SetFocus; … … 54 78 procedure TfrmTemplateFields.FormCreate(Sender: TObject); 55 79 begin 56 cboObjects.InitLongList('');57 cboObjects.ItemHeight := 15;58 ResizeAnchoredFormToFont(self);59 //ResizeAnchoredFormToFont doesn't work right on the button positions for some reason.60 btnCancel.Left := pnlBottom.ClientWidth - btnCancel.Width;61 btnInsert.Left := btnCancel.Left - btnInsert.Width - 8;80 ResizeFormToFont(self); 81 cboObjects.ItemHeight := lblReq.Height - 1; 82 FInsertAllowed := TRUE; 83 lblReq.Top := (pnlBottom.Height - lblReq.Height); 84 pnlSRIntro.Height := lblSRStop.Height; 85 pnlBottomSR.Height := lblSRCont1.Height * 4 + 5; 62 86 end; 63 87 … … 76 100 var 77 101 cnt: integer; 78 79 begin 102 p1, p2: string; 103 check: boolean; 104 i: integer; 105 106 begin 107 p1 := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1); 108 if p1 = '' then exit; 80 109 if assigned(Fre) and (not TORExposedCustomEdit(Fre).ReadOnly) and (cboObjects.ItemIndex >= 0) then 81 110 begin … … 83 112 cnt := TRichEdit(FRe).Lines.Count 84 113 else 85 cnt :=0; 86 Fre.SelText := TemplateFieldBeginSignature + 87 Piece(cboObjects.Items[cboObjects.ItemIndex],U,2)+ 88 TemplateFieldEndSignature; 114 cnt := 0; 115 if StrToIntDef(p1, 0) < 0 then 116 begin 117 check := true; 118 for i := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do 119 begin 120 if p1 = ScreenReaderCodeIDs[i] then 121 begin 122 p2 := ScreenReaderCodes[i]; 123 check := FALSE; 124 break; 125 end; 126 end; 127 end 128 else 129 check := TRUE; 130 if check then 131 p2 := TemplateFieldBeginSignature + Piece(cboObjects.Items[cboObjects.ItemIndex],U,2) + 132 TemplateFieldEndSignature; 133 Fre.SelText := p2; 89 134 if Fre is TRichEdit then 90 135 if(assigned(FAutoLongLines) and (cnt <> TRichEdit(FRe).Lines.Count)) then … … 95 140 procedure TfrmTemplateFields.cboObjectsDblClick(Sender: TObject); 96 141 begin 97 if btnInsert.Enabledthen142 if ValidInsert then 98 143 InsertField; 99 144 end; … … 118 163 procedure TfrmTemplateFields.UpdateStatus; 119 164 begin 120 btnInsert.Enabled := (not TORExposedCustomEdit(re).ReadOnly); 165 FInsertAllowed := (not TORExposedCustomEdit(re).ReadOnly); 166 btnInsert.Enabled := ValidInsert and FInsertAllowed; 167 end; 168 169 function TfrmTemplateFields.ValidInsert: boolean; 170 begin 171 Result := (cboObjects.ItemIndex >= 0); 172 if Result then 173 Result := (Piece(cboObjects.Items[cboObjects.ItemIndex],U,1) <> ''); 174 end; 175 176 function TfrmTemplateFields.ValidPreview: boolean; 177 var 178 i: integer; 179 code: string; 180 begin 181 Result := ValidInsert; 182 if Result then 183 begin 184 code := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1); 185 for I := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do 186 begin 187 if code = ScreenReaderCodeIDs[i] then 188 begin 189 Result := FALSE; 190 break; 191 end; 192 end; 193 end; 121 194 end; 122 195 123 196 procedure TfrmTemplateFields.btnInsertClick(Sender: TObject); 124 197 begin 125 InsertField; 198 if ValidInsert then 199 InsertField; 126 200 end; 127 201 … … 147 221 procedure TfrmTemplateFields.cboObjectsChange(Sender: TObject); 148 222 begin 149 btnPreview.Enabled := (cboObjects.ItemIndex >= 0) 223 btnPreview.Enabled := ValidPreview; 224 btnInsert.Enabled := ValidInsert and FInsertAllowed; 150 225 end; 151 226 -
cprs/trunk/CPRS-Chart/Templates/fTemplateImport.dfm
r456 r829 1 objectfrmTemplateImport: TfrmTemplateImport1 inherited frmTemplateImport: TfrmTemplateImport 2 2 Left = 273 3 3 Top = 195 … … 7 7 ClientHeight = 132 8 8 ClientWidth = 288 9 Color = clBtnFace10 Font.Charset = DEFAULT_CHARSET11 Font.Color = clWindowText12 Font.Height = -1113 Font.Name = 'MS Sans Serif'14 Font.Style = []15 9 FormStyle = fsStayOnTop 16 OldCreateOrder = False17 10 Position = poScreenCenter 18 11 PixelsPerInch = 96 19 12 TextHeight = 13 20 object gaugeImport: TGauge 13 object gaugeImport: TGauge [0] 21 14 Left = 8 22 15 Top = 82 23 16 Width = 272 24 17 Height = 21 25 ForeColor = clNavy 18 BackColor = clHighlightText 19 ForeColor = clHighlight 20 Font.Charset = DEFAULT_CHARSET 21 Font.Color = clCaptionText 22 Font.Height = -11 23 Font.Name = 'MS Sans Serif' 24 Font.Style = [] 25 ParentFont = False 26 26 Progress = 0 27 27 end 28 object lblImporting: TStaticText 28 object lblImporting: TStaticText [1] 29 29 Left = 8 30 30 Top = 4 … … 37 37 TabOrder = 0 38 38 end 39 object animImport: TAnimate 39 object animImport: TAnimate [2] 40 40 Left = 8 41 41 Top = 20 … … 44 44 Active = True 45 45 CommonAVI = aviCopyFile 46 StopFrame = 2 646 StopFrame = 20 47 47 end 48 object btnCancel: TButton 48 object btnCancel: TButton [3] 49 49 Left = 106 50 50 Top = 106 … … 57 57 OnClick = btnCancelClick 58 58 end 59 inherited amgrMain: TVA508AccessibilityManager 60 Data = ( 61 ( 62 'Component = lblImporting' 63 'Status = stsDefault') 64 ( 65 'Component = animImport' 66 'Status = stsDefault') 67 ( 68 'Component = btnCancel' 69 'Status = stsDefault') 70 ( 71 'Component = frmTemplateImport' 72 'Status = stsDefault')) 73 end 59 74 end -
cprs/trunk/CPRS-Chart/Templates/fTemplateImport.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 Gauges, StdCtrls, ComCtrls ;7 Gauges, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager; 8 8 9 9 type 10 TfrmTemplateImport = class(T Form)10 TfrmTemplateImport = class(TfrmBase508Form) 11 11 animImport: TAnimate; 12 12 btnCancel: TButton; -
cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.dfm
r456 r829 1 objectfrmTemplateObjects: TfrmTemplateObjects1 inherited frmTemplateObjects: TfrmTemplateObjects 2 2 Left = 215 3 3 Top = 343 4 Width = 2475 Height = 3006 4 ActiveControl = cboObjects 7 5 Caption = 'Insert Patient Data (Object)' 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 = 273 7 ClientWidth = 239 14 8 FormStyle = fsStayOnTop 15 OldCreateOrder = False16 9 Position = poOwnerFormCenter 17 10 OnClose = FormClose 18 11 OnShow = FormShow 12 ExplicitWidth = 247 13 ExplicitHeight = 300 19 14 PixelsPerInch = 96 20 15 TextHeight = 13 21 object cboObjects: TORComboBox 16 object cboObjects: TORComboBox [0] 22 17 Left = 0 23 18 Top = 0 … … 42 37 TabOrder = 0 43 38 OnDblClick = cboObjectsDblClick 39 CharsNeedMatch = 1 44 40 end 45 object pnlBottom: TPanel 41 object pnlBottom: TPanel [1] 46 42 Left = 0 47 43 Top = 246 … … 91 87 end 92 88 end 89 inherited amgrMain: TVA508AccessibilityManager 90 Data = ( 91 ( 92 'Component = cboObjects' 93 'Status = stsDefault') 94 ( 95 'Component = pnlBottom' 96 'Status = stsDefault') 97 ( 98 'Component = btnCancel' 99 'Status = stsDefault') 100 ( 101 'Component = btnInsert' 102 'Status = stsDefault') 103 ( 104 'Component = btnRefresh' 105 'Status = stsDefault') 106 ( 107 'Component = frmTemplateObjects' 108 'Status = stsDefault')) 109 end 93 110 end -
cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared; 7 ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared, uTemplates, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmTemplateObjects = class(T Form)11 TfrmTemplateObjects = class(TfrmBase508Form) 11 12 cboObjects: TORComboBox; 12 13 pnlBottom: TPanel; … … 93 94 94 95 procedure TfrmTemplateObjects.btnRefreshClick(Sender: TObject); 96 var 97 i: integer; 98 DoIt: boolean; 95 99 begin 96 cboObjects.SelectAll; 97 cboObjects.Clear; 98 dmodShared.RefreshObject := true; 99 dmodShared.LoadTIUObjects; 100 CboOBJECTS.Items.AddStrings(dmodShared.TIUObjects); 100 cboObjects.Clear; 101 dmodShared.RefreshObject := true; 102 dmodShared.LoadTIUObjects; 103 //---------- CQ #8665 - RV ---------------- 104 DoIt := TRUE; 105 UpdatePersonalObjects; 106 if uPersonalObjects.Count > 0 then 107 begin 108 DoIt := FALSE; 109 for i := 0 to dmodShared.TIUObjects.Count-1 do 110 if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then 111 cboObjects.Items.Add(dmodShared.TIUObjects[i]); 112 end; 113 if DoIt then 114 //---------- end CQ #8665 ------------------ 115 cboObjects.Items.Assign(dmodShared.TIUObjects); 101 116 end; 102 117 103 118 end. 119 -
cprs/trunk/CPRS-Chart/Templates/fTemplateView.dfm
r456 r829 1 objectfrmTemplateView: TfrmTemplateView1 inherited frmTemplateView: TfrmTemplateView 2 2 Left = 257 3 3 Top = 105 4 Width = 5785 Height = 3726 4 Caption = 'View Template' 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 OldCreateOrder = False 5 ClientHeight = 343 6 ClientWidth = 568 14 7 Position = poScreenCenter 15 8 OnClose = FormClose 16 9 OnCreate = FormCreate 17 10 OnDestroy = FormDestroy 18 OnShow = FormShow 11 ExplicitWidth = 576 12 ExplicitHeight = 370 19 13 PixelsPerInch = 96 20 14 TextHeight = 13 21 object pnlBottom: TPanel 15 object pnlBottom: TPanel [0] 22 16 Left = 0 23 Top = 31 524 Width = 5 7017 Top = 313 18 Width = 568 25 19 Height = 30 26 20 Align = alBottom … … 28 22 TabOrder = 1 29 23 DesignSize = ( 30 5 7024 568 31 25 30) 32 26 object btnClose: TButton 33 Left = 49 427 Left = 492 34 28 Top = 6 35 29 Width = 75 … … 52 46 end 53 47 object btnPrint: TButton 54 Left = 41 448 Left = 412 55 49 Top = 6 56 50 Width = 75 … … 62 56 end 63 57 end 64 object reMain: TRichEdit 58 object reMain: TRichEdit [1] 65 59 Left = 0 66 60 Top = 0 67 Width = 5 7068 Height = 31 561 Width = 568 62 Height = 313 69 63 Align = alClient 70 64 Color = clCream … … 82 76 WantReturns = False 83 77 WordWrap = False 78 end 79 inherited amgrMain: TVA508AccessibilityManager 80 Data = ( 81 ( 82 'Component = pnlBottom' 83 'Status = stsDefault') 84 ( 85 'Component = btnClose' 86 'Status = stsDefault') 87 ( 88 'Component = cbStayOnTop' 89 'Status = stsDefault') 90 ( 91 'Component = btnPrint' 92 'Status = stsDefault') 93 ( 94 'Component = reMain' 95 'Status = stsDefault') 96 ( 97 'Component = frmTemplateView' 98 'Status = stsDefault')) 84 99 end 85 100 object popView: TPopupMenu -
cprs/trunk/CPRS-Chart/Templates/fTemplateView.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn; 7 StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn, fBase508Form, 8 VA508AccessibilityManager; 8 9 9 10 type 10 TfrmTemplateView = class(T Form)11 TfrmTemplateView = class(TfrmBase508Form) 11 12 pnlBottom: TPanel; 12 13 reMain: TRichEdit; … … 26 27 procedure SelectAll1Click(Sender: TObject); 27 28 procedure btnPrintClick(Sender: TObject); 29 procedure AlignButtons(); 28 30 procedure FormCreate(Sender: TObject); 29 procedure FormShow(Sender: TObject);30 31 private 31 32 end; … … 52 53 if(not assigned(frmTemplateView)) then 53 54 frmTemplateView := TfrmTemplateView.Create(Application); 54 ResizeAnchoredFormToFont(frmTemplateView); 55 //Quick fix to work around glich in resize algorithm 56 frmTemplateView.AlignButtons(); 55 57 frmTemplateView.reMain.Lines.Clear; 56 58 frmTemplateView.Caption := 'Template: ' + Title; … … 80 82 SaveUserBounds(frmTemplateView); 81 83 Action := caFree; 84 end; 85 86 procedure TfrmTemplateView.FormCreate(Sender: TObject); 87 begin 88 inherited; 89 ResizeAnchoredFormToFont(Self); 90 SetFormPosition(Self); 82 91 end; 83 92 … … 118 127 end; 119 128 120 procedure TfrmTemplateView.FormCreate(Sender: TObject); 129 procedure TfrmTemplateView.AlignButtons; 130 Const 131 BtnSpace = 8; 121 132 begin 122 reMain.Color := ReadOnlyColor; 123 end; 124 125 procedure TfrmTemplateView.FormShow(Sender: TObject); 126 begin 127 SetFormPosition(frmTemplateView); 133 btnClose.Left := frmTemplateView.Width - btnClose.Width - BtnSpace; 134 btnPrint.Left := btnClose.Left - BtnSpace - btnPrint.Width; 128 135 end; 129 136 -
cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.dfm
r456 r829 2 2 Left = 0 3 3 Top = 0 4 Width = 1 094 Width = 136 5 5 Height = 14 6 AutoScroll = True 6 7 Font.Charset = ANSI_CHARSET 7 8 Font.Color = clWindowText … … 12 13 TabOrder = 0 13 14 TabStop = True 14 OnEnter = pnlBtnEnter15 OnExit = pnlBtnExit15 OnEnter = FrameEnter 16 OnExit = FrameExit 16 17 object pnlBtn: TPanel 17 18 Left = 0 18 19 Top = 0 19 Width = 1 0920 Width = 136 20 21 Height = 14 21 22 Align = alClient 22 23 TabOrder = 0 24 OnExit = FrameExit 23 25 OnMouseDown = pnlBtnMouseDown 24 26 OnMouseUp = pnlBtnMouseUp 27 DesignSize = ( 28 136 29 14) 25 30 object lblText: TLabel 26 31 Left = 2 27 32 Top = -1 28 Width = 1 0533 Width = 132 29 34 Height = 14 30 35 Alignment = taCenter … … 35 40 OnMouseDown = pnlBtnMouseDown 36 41 OnMouseUp = pnlBtnMouseUp 42 ExplicitWidth = 105 37 43 end 38 44 object pbFocus: TPaintBox 39 45 Left = 1 40 46 Top = 1 41 Width = 1 0747 Width = 134 42 48 Height = 12 43 49 Align = alClient … … 45 51 OnMouseUp = pnlBtnMouseUp 46 52 OnPaint = pbFocusPaint 53 ExplicitWidth = 107 47 54 end 48 55 end -
cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ExtCtrls ;7 StdCtrls, ExtCtrls, uDlgComponents, VA508AccessibilityManager; 8 8 9 9 type 10 TfraTemplateFieldButton = class(TFrame )10 TfraTemplateFieldButton = class(TFrame, ICPRSDialogComponent) 11 11 pnlBtn: TPanel; 12 12 lblText: TLabel; … … 16 16 procedure pnlBtnMouseUp(Sender: TObject; Button: TMouseButton; 17 17 Shift: TShiftState; X, Y: Integer); 18 procedure pnlBtnEnter(Sender: TObject);19 procedure pnlBtnExit(Sender: TObject);18 procedure FrameEnter(Sender: TObject); 19 procedure FrameExit(Sender: TObject); 20 20 procedure pbFocusPaint(Sender: TObject); 21 21 private 22 FCPRSDialogData: ICPRSDialogComponent; 22 23 FBtnDown: boolean; 23 24 FItems: TStringList; … … 33 34 property Items: TStringList read FItems; 34 35 property OnChange: TNotifyEvent read FOnChange write FOnChange; 36 property CPRSDialogData: ICPRSDialogComponent read FCPRSDialogData implements ICPRSDialogComponent; 35 37 end; 36 38 … … 40 42 41 43 uses 42 ORFn ;43 44 ORFn, VA508AccessibilityRouter; 45 44 46 procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton; 45 47 Shift: TShiftState; X, Y: Integer); … … 69 71 idx := 0; 70 72 ButtonText := FItems[idx]; 73 if ScreenReaderSystemActive then 74 begin 75 txt := FItems[idx]; 76 if Trim(txt) = '' then 77 txt := 'blank'; 78 GetScreenReader.Speak(txt); 79 end; 71 80 if assigned(FOnChange) then 72 81 FOnChange(Self); … … 86 95 end; 87 96 88 procedure TfraTemplateFieldButton.pnlBtnEnter(Sender: TObject); 97 type 98 TWinControlFriend = class(TWinControl); 99 100 procedure TfraTemplateFieldButton.FrameEnter(Sender: TObject); 89 101 begin 90 102 pbFocus.Invalidate; 91 103 end; 92 104 93 procedure TfraTemplateFieldButton. pnlBtnExit(Sender: TObject);105 procedure TfraTemplateFieldButton.FrameExit(Sender: TObject); 94 106 begin 95 107 pbFocus.Invalidate; … … 98 110 constructor TfraTemplateFieldButton.Create(AOwner: TComponent); 99 111 begin 100 inherited; 112 inherited Create(AOwner); 113 TabStop := TRUE; 101 114 FItems := TStringList.Create; 102 115 OnKeyDown := ButtonKeyDown; 103 116 OnKeyUp := ButtonKeyUp; 104 117 Font.Size := MainFontSize; 118 FCPRSDialogData := TCPRSDialogComponent.Create(Self, 'multi value button'); 105 119 end; 106 120 … … 142 156 begin 143 157 FItems.Free; 158 FCPRSDialogData := nil; 144 159 inherited; 145 160 end; 146 161 162 initialization 163 SpecifyFormIsNotADialog(TfraTemplateFieldButton); 164 147 165 end. -
cprs/trunk/CPRS-Chart/Templates/rTemplates.pas
r456 r829 105 105 CallBroker; 106 106 RPCBrokerV.Results.Delete(0); 107 BoilerPlate.Assign(RPCBrokerV.Results);107 FastAssign(RPCBrokerV.Results, BoilerPlate); 108 108 RPCBrokerV.Results.Clear; 109 109 end; … … 260 260 TmpList := TStringList.Create; 261 261 try 262 TmpList.Assign(RPCBrokerV.Results);262 FastAssign(RPCBrokerV.Results, TmpList); 263 263 SortByPiece(TmpList, U, 2); 264 264 MixedCaseList(TmpList); 265 RPCBrokerV.Results.Assign(TmpList);265 FastAssign(TmpList, RPCBrokerV.Results); 266 266 finally 267 267 TmpList.Free; … … 377 377 begin 378 378 CallV('TIU FIELD CHECK',[nil]); 379 ResultString.Assign(RPCBrokerV.Results);379 FastAssign(RPCBrokerV.Results, ResultString); 380 380 end; 381 381 … … 398 398 CallBroker; 399 399 end; 400 Text.Assign(RPCBrokerV.Results);400 FastAssign(RPCBrokerV.Results, Text); 401 401 end; 402 402 … … 449 449 Result := TRUE; 450 450 CallV('TIU FIELD LIST IMPORT',[nil]); 451 ResultSet.Assign(RPCBrokerV.Results);451 FastAssign(RPCBrokerV.Results, ResultSet); 452 452 if ResultSet.Count < 1 then 453 453 Result := FALSE; -
cprs/trunk/CPRS-Chart/Templates/uTemplateFields.pas
r456 r829 5 5 uses 6 6 Forms, SysUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs, 7 Graphics, ORClasses, ComCtrls, ORDtTm ;7 Graphics, ORClasses, ComCtrls, ORDtTm, uDlgComponents, TypInfo, ORFn, StrUtils; 8 8 9 9 type 10 10 TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes, 11 dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText); 11 dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText, 12 // keep dftScreenReader as last entry - users can not create this type of field 13 dftScreenReader); 12 14 13 15 TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime, … … 30 32 FID: string; 31 33 FFont: TFont; 32 FPanel: T Panel;34 FPanel: TDlgFieldPanel; 33 35 FControls: TStringList; 34 36 FIndents: TStringList; … … 47 49 procedure SetFieldValues(const Value: string); 48 50 procedure SetAutoDestroyOnPanelFree(const Value: boolean); 51 function StripCode(var txt: string; code: char): boolean; 49 52 protected 50 53 procedure UpDownChange(Sender: TObject); … … 57 60 constructor Create(AParent: TWinControl; AID, Text: string); 58 61 destructor Destroy; override; 59 function GetPanel(MaxLen: integer; AParent: TWinControl): TPanel; 62 function GetPanel(MaxLen: integer; AParent: TWinControl; 63 OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel; 60 64 function GetText: string; 61 65 property Text: string read FText write FText; … … 174 178 procedure ConvertCodes2Text(sl: TStrings; Short: boolean); 175 179 function StripEmbedded(iItems: string): string; 180 procedure StripScreenReaderCodes(var Text: string); overload; 181 procedure StripScreenReaderCodes(SL: TStrings); overload; 182 function HasScreenReaderBreakCodes(SL: TStrings): boolean; 176 183 177 184 const 178 TemplateFieldBeginSignature = '{FLD:'; 185 TemplateFieldSignature = '{FLD'; 186 TemplateFieldBeginSignature = TemplateFieldSignature + ':'; 179 187 TemplateFieldEndSignature = '}'; 188 ScreenReaderCodeSignature = '{SR-'; 189 ScreenReaderCodeType = ' Screen Reader Code'; 190 ScreenReaderCodeCount = 2; 191 ScreenReaderShownCount = 1; 192 ScreenReaderStopCode = ScreenReaderCodeSignature + 'STOP' + TemplateFieldEndSignature; 193 ScreenReaderStopCodeLen = Length(ScreenReaderStopCode); 194 ScreenReaderStopCodeID = '-43'; 195 ScreenReaderStopName = 'SCREEN READER STOP CODE **'; 196 ScreenReaderStopCodeLine = ScreenReaderStopCodeID + U + ScreenReaderStopName + U + ScreenReaderCodeType; 197 ScreenReaderContinueCode = ScreenReaderCodeSignature + 'CONT' + TemplateFieldEndSignature; 198 ScreenReaderContinueCodeLen = Length(ScreenReaderContinueCode); 199 ScreenReaderContinueCodeOld = ScreenReaderCodeSignature + 'CONTINUE' + TemplateFieldEndSignature; 200 ScreenReaderContinueCodeOldLen = Length(ScreenReaderContinueCodeOld); 201 ScreenReaderContinueCodeID = '-44'; 202 ScreenReaderContinueCodeName = 'SCREEN READER CONTINUE CODE ***'; 203 ScreenReaderContinueCodeLine = ScreenReaderContinueCodeID + U + ScreenReaderContinueCodeName + U + ScreenReaderCodeType; 180 204 MissingFieldsTxt = 'One or more required fields must still be entered.'; 205 206 ScreenReaderCodes: array[0..ScreenReaderCodeCount] of string = 207 (ScreenReaderStopCode, ScreenReaderContinueCode, ScreenReaderContinueCodeOld); 208 ScreenReaderCodeLens: array[0..ScreenReaderCodeCount] of integer = 209 (ScreenReaderStopCodeLen, ScreenReaderContinueCodeLen, ScreenReaderContinueCodeOldLen); 210 ScreenReaderCodeIDs: array[0..ScreenReaderShownCount] of string = 211 (ScreenReaderStopCodeID, ScreenReaderContinueCodeID); 212 ScreenReaderCodeLines: array[0..ScreenReaderShownCount] of string = 213 (ScreenReaderStopCodeLine, ScreenReaderContinueCodeLine); 181 214 182 215 TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] = … … 191 224 { dftHyperlink } 'H', 192 225 { dftWP } 'W', 193 { dftText } 'T'); 226 { dftText } 'T', 227 { dftScreenReader } 'S'); 194 228 195 229 TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string = 196 230 { dftUnknown } (('',''), 197 { dftEditBox } ('Edit Box', 'Edit'), 198 { dftComboBox } ('Combo Box', 'Combo'), 199 { dftButton } ('Button', 'Button'), 200 { dftCheckBoxes } ('Check Boxes', 'Check'), 201 { dftRadioButtons } ('Radio Buttons', 'Radio'), 202 { dftDate } ('Date', 'Date'), 203 { dftNumber } ('Number', 'Num'), 204 { dftHyperlink } ('Hyperlink', 'Link'), 205 { dftWP } ('Word Processing','WP'), 206 { dftWP } ('Display Text', 'Text')); 231 { dftEditBox } ('Edit Box', 'Edit'), 232 { dftComboBox } ('Combo Box', 'Combo'), 233 { dftButton } ('Button', 'Button'), 234 { dftCheckBoxes } ('Check Boxes', 'Check'), 235 { dftRadioButtons } ('Radio Buttons', 'Radio'), 236 { dftDate } ('Date', 'Date'), 237 { dftNumber } ('Number', 'Num'), 238 { dftHyperlink } ('Hyperlink', 'Link'), 239 { dftWP } ('Word Processing', 'WP'), 240 { dftText } ('Display Text', 'Text'), 241 { dftScreenReader } ('Screen Reader Stop', 'SRStop')); 207 242 208 243 TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string = … … 226 261 { dftHyperlink } 'LINK', 227 262 { dftWP } 'WRDP', 228 { dftTExt } 'TEXT'); 263 { dftTExt } 'TEXT', 264 { dftScreenReader } 'SRST'); 229 265 230 266 TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] = … … 239 275 MaxTFWPLines = 20; 240 276 MaxTFEdtLen = 70; 241 242 type 243 TFieldPanel = class(TPanel) {This is the panel associated with the child} 244 private {dialog checkboxes in reminders dialogs} 245 FOnDestroy: TNotifyEvent; 246 FCanvas: TControlCanvas; {used to draw focus rect} 247 function GetFocus: boolean; 248 procedure SetTheFocus(const Value: boolean); 249 protected {used to draw focus rect} 250 procedure Paint; override; {used to draw focus rect} 251 public 252 destructor Destroy; override; 253 property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; 254 property Focus: boolean read GetFocus write SetTheFocus; {to draw focus rect} 255 property OnKeyPress; {to click the checkbox when spacebar is pressed} 256 end; 257 277 258 278 implementation 259 279 260 280 uses 261 ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows; 281 rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows, 282 VAUtils, VA508AccessibilityManager, VA508AccessibilityRouter; 262 283 263 284 const … … 279 300 FieldIDLen = 6; 280 301 NewLine = 'NL'; 281 282 type283 TFieldLabel = class(TLabel)284 private285 FExclude: boolean;286 public287 property Exclude: boolean read FExclude;288 end;289 290 TWebLabel = class(TFieldLabel)291 private292 FAddr: string;293 procedure Clicked(Sender: TObject);294 public295 procedure Init(Addr: string);296 end;297 302 298 303 function GetNewFieldID: string; … … 694 699 Result := (msg <> ''); 695 700 if(Result) then 696 ShowM essage(msg);701 ShowMsg(msg); 697 702 end; 698 703 … … 861 866 AList.Add(''); 862 867 AList.Add('The following inactive template fields were found:'); 863 AList.AddStrings(InactiveList);868 FastAddStrings(InactiveList, AList); 864 869 end; 865 870 if(AList.Count > 0) then … … 1079 1084 dbox: TORDateBox; 1080 1085 dcbo: TORDateCombo; 1081 lbl: T FieldLabel;1086 lbl: TCPRSTemplateFieldLabel; 1082 1087 re: TRichEdit; 1083 pnl: TPanel; 1084 ud: TUpDown; 1088 pnl: TCPRSDialogNumber; 1085 1089 DefDate: TFMDateTime; 1086 1090 ctrl: TControl; … … 1123 1127 dftEditBox: 1124 1128 begin 1125 edt := TEdit.Create(nil); 1129 edt := TCPRSDialogFieldEdit.Create(nil); 1130 (edt as ICPRSDialogComponent).RequiredField := Required; 1126 1131 edt.Parent := Entry.FPanel; 1127 1132 edt.BorderStyle := bsNone; … … 1135 1140 edt.Tag := CtrlID; 1136 1141 edt.OnChange := Entry.DoChange; 1142 UpdateColorsFor508Compliance(edt, TRUE); 1137 1143 ctrl := edt; 1138 1144 end; … … 1140 1146 dftComboBox: 1141 1147 begin 1142 cbo := TORComboBox.Create(nil); 1148 cbo := TCPRSDialogComboBox.Create(nil); 1149 (cbo as ICPRSDialogComponent).RequiredField := Required; 1143 1150 cbo.Parent := Entry.FPanel; 1144 1151 cbo.TemplateField := TRUE; … … 1165 1172 cbo.DropDownCount := cbo.Items.Count; 1166 1173 end; 1174 UpdateColorsFor508Compliance(cbo, TRUE); 1167 1175 ctrl := cbo; 1168 1176 end; … … 1171 1179 begin 1172 1180 btn := TfraTemplateFieldButton.Create(nil); 1181 (btn as ICPRSDialogComponent).RequiredField := Required; 1173 1182 btn.Parent := Entry.FPanel; 1174 1183 {Clear out embedded fields} … … 1179 1188 btn.Tag := CtrlID; 1180 1189 btn.OnChange := Entry.DoChange; 1190 UpdateColorsFor508Compliance(btn); 1181 1191 ctrl := btn; 1182 1192 end; … … 1192 1202 for i := 0 to TmpSL.Count-1 do 1193 1203 begin 1194 cb := TORCheckBox.Create(nil); 1204 cb := TCPRSDialogCheckBox.Create(nil); 1205 if i = 0 then 1206 (cb as ICPRSDialogComponent).RequiredField := Required; 1195 1207 cb.Parent := Entry.FPanel; 1196 1208 cb.Caption := TmpSL[i]; … … 1210 1222 cb.StringData := NewLine; 1211 1223 cb.OnClick := Entry.DoChange; 1224 UpdateColorsFor508Compliance(cb); 1212 1225 inc(Index); 1213 1226 Entry.FControls.InsertObject(Index, '', cb); … … 1228 1241 if FDateType in DateComboTypes then 1229 1242 begin 1230 dcbo := TORDateCombo.Create(nil); 1243 dcbo := TCPRSDialogDateCombo.Create(nil); 1244 (dcbo as ICPRSDialogComponent).RequiredField := Required; 1231 1245 dcbo.Parent := Entry.FPanel; 1232 1246 dcbo.Tag := CtrlID; … … 1237 1251 dcbo.TemplateField := TRUE; 1238 1252 dcbo.OnChange := Entry.DoChange; 1253 UpdateColorsFor508Compliance(dcbo, TRUE); 1239 1254 ctrl := dcbo; 1240 1255 end 1241 1256 else 1242 1257 begin 1243 dbox := TORDateBox.Create(nil); 1258 dbox := TCPRSDialogDateBox.Create(nil); 1259 (dbox as ICPRSDialogComponent).RequiredField := Required; 1244 1260 dbox.Parent := Entry.FPanel; 1245 1261 dbox.Tag := CtrlID; … … 1254 1270 dbox.Width := (wdth * tmp) + 18; 1255 1271 dbox.OnChange := Entry.DoChange; 1272 UpdateColorsFor508Compliance(dbox, TRUE); 1256 1273 ctrl := dbox; 1257 1274 end; … … 1260 1277 dftNumber: 1261 1278 begin 1262 pnl := TPanel.Create(nil); 1279 pnl := TCPRSDialogNumber.CreatePanel(nil); 1280 (pnl as ICPRSDialogComponent).RequiredField := Required; 1263 1281 pnl.Parent := Entry.FPanel; 1264 1282 pnl.BevelOuter := bvNone; 1265 1283 pnl.Tag := CtrlID; 1266 edt := TEdit.Create(pnl); 1267 edt.Parent := pnl; 1268 edt.BorderStyle := bsNone; 1269 edt.Height := ht; 1270 edt.Width := (wdth * 5 + 4); 1271 edt.Top := 0; 1272 edt.Left := 0; 1273 edt.AutoSelect := True; 1274 ud := TUpDown.Create(pnl); 1275 ud.Parent := pnl; 1276 ud.Associate := edt; 1277 ud.Min := MinVal; 1278 ud.Max := MaxVal; 1279 ud.Min := MinVal; // Both ud.Min settings are needeed! 1284 pnl.Edit.Height := ht; 1285 pnl.Edit.Width := (wdth * 5 + 4); 1286 pnl.UpDown.Min := MinVal; 1287 pnl.UpDown.Max := MaxVal; 1288 pnl.UpDown.Min := MinVal; // Both ud.Min settings are needeed! 1280 1289 i := Increment; 1281 1290 if i < 1 then i := 1; 1282 ud.Increment := i; 1283 ud.Thousands := FALSE; 1284 ud.Position := StrToIntDef(EditDefault, 0); 1285 edt.Tag := Integer(ud); 1286 edt.OnChange := Entry.UpDownChange; 1287 pnl.Height := edt.Height; 1288 pnl.Width := edt.Width + ud.Width; 1291 pnl.UpDown.Increment := i; 1292 pnl.UpDown.Position := StrToIntDef(EditDefault, 0); 1293 pnl.Edit.OnChange := Entry.UpDownChange; 1294 pnl.Height := pnl.Edit.Height; 1295 pnl.Width := pnl.Edit.Width + pnl.UpDown.Width; 1296 UpdateColorsFor508Compliance(pnl, TRUE); 1289 1297 ctrl := pnl; 1290 1298 end; … … 1293 1301 begin 1294 1302 if (FFldType = dftHyperlink) and User.WebAccess then 1295 lbl := T WebLabel.Create(nil)1303 lbl := TCPRSDialogHyperlinkLabel.Create(nil) 1296 1304 else 1297 lbl := T FieldLabel.Create(nil);1305 lbl := TCPRSTemplateFieldLabel.Create(nil); 1298 1306 lbl.Parent := Entry.FPanel; 1299 1307 lbl.ShowAccelChar := FALSE; 1300 lbl. FExclude := FSepLines;1308 lbl.Exclude := FSepLines; 1301 1309 if (FFldType = dftHyperlink) then 1302 1310 begin … … 1313 1321 lbl.Caption := STmp; 1314 1322 end; 1315 if lbl is T WebLabel then1316 T WebLabel(lbl).Init(FURL);1323 if lbl is TCPRSDialogHyperlinkLabel then 1324 TCPRSDialogHyperlinkLabel(lbl).Init(FURL); 1317 1325 lbl.Tag := CtrlID; 1326 UpdateColorsFor508Compliance(lbl); 1318 1327 ctrl := lbl; 1319 1328 end; … … 1321 1330 dftWP: 1322 1331 begin 1323 re := TRichEdit.Create(nil); 1332 re := TCPRSDialogRichEdit.Create(nil); 1333 (re as ICPRSDialogComponent).RequiredField := Required; 1324 1334 re.Parent := Entry.FPanel; 1325 1335 re.Tag := CtrlID; … … 1339 1349 re.Lines.Text := Items; 1340 1350 re.OnChange := Entry.DoChange; 1351 UpdateColorsFor508Compliance(re, TRUE); 1341 1352 ctrl := re; 1342 1353 end; … … 1358 1369 Result := FLocked; 1359 1370 if(not FLocked) then 1360 ShowM essage('Template Field ' + FFldName + ' is currently being edited by another user.');1371 ShowMsg('Template Field ' + FFldName + ' is currently being edited by another user.'); 1361 1372 end 1362 1373 else … … 1707 1718 const 1708 1719 EOL_MARKER = #182; 1720 SR_BREAK = #186; 1709 1721 1710 1722 procedure PanelDestroy(AData: Pointer; Sender: TObject); … … 1737 1749 FControls.Text := Text; 1738 1750 if(FControls.Count > 1) then 1751 begin 1739 1752 for i := 1 to FControls.Count-1 do 1740 1753 FControls[i] := EOL_MARKER + FControls[i]; 1754 if not ScreenReaderSystemActive then 1755 StripScreenReaderCodes(FControls); 1756 end; 1741 1757 FFirstBuild := TRUE; 1742 FPanel := T FieldPanel.Create(AParent.Owner);1758 FPanel := TDlgFieldPanel.Create(AParent.Owner); 1743 1759 FPanel.Parent := AParent; 1744 1760 FPanel.BevelOuter := bvNone; 1745 1761 FPanel.Caption := ''; 1746 1762 FPanel.Font.Assign(FFont); 1763 UpdateColorsFor508Compliance(FPanel, TRUE); 1747 1764 idx := 0; 1748 1765 while (idx < FControls.Count) do … … 1771 1788 FControls[idx] := copy(txt,1,i-1); 1772 1789 if(Fld.Required) then 1790 begin 1791 if ScreenReaderSystemActive then 1792 begin 1793 if Fld.FFldType in [dftCheckBoxes, dftRadioButtons] then 1794 FControls[idx] := FControls[idx] + ScreenReaderStopCode; 1795 end; 1773 1796 FControls[idx] := FControls[idx] + '*'; 1797 end; 1774 1798 Fld.CreateDialogControls(Self, idx, CtrlID); 1775 1799 FControls.Insert(idx+1,copy(txt,i,MaxInt)); … … 1789 1813 end; 1790 1814 inc(idx); 1815 end; 1816 if ScreenReaderSystemActive then 1817 begin 1818 idx := 0; 1819 while (idx < FControls.Count) do 1820 begin 1821 txt := FControls[idx]; 1822 i := pos(ScreenReaderStopCode, txt); 1823 if i > 0 then 1824 begin 1825 FControls[idx] := copy(txt, 1, i-1); 1826 txt := copy(txt, i + ScreenReaderStopCodeLen, MaxInt); 1827 FControls.Insert(idx+1, SR_BREAK + txt); 1828 end; 1829 inc(idx); 1830 end; 1791 1831 end; 1792 1832 end; … … 1867 1907 ind := 0; 1868 1908 end; 1869 if(Ctrl is T FieldLabel) then1870 begin 1871 if not T FieldLabel(Ctrl).Exclude then begin1909 if(Ctrl is TCPRSTemplateFieldLabel) then 1910 begin 1911 if not TCPRSTemplateFieldLabel(Ctrl).Exclude then begin 1872 1912 if emField <> '' then begin 1873 1913 iField := GetTemplateField(emField,FALSE); … … 1884 1924 end; 1885 1925 else {case} 1886 Result := T FieldLabel(Ctrl).Caption1926 Result := TCPRSTemplateFieldLabel(Ctrl).Caption 1887 1927 end; {case iField.FldType} 1888 1928 end {if emField} 1889 1929 else 1890 Result := T FieldLabel(Ctrl).Caption;1930 Result := TCPRSTemplateFieldLabel(Ctrl).Caption; 1891 1931 end; 1892 1932 end … … 2014 2054 end; 2015 2055 2016 function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel; 2017 var 2018 i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer; 2056 function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl; 2057 OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel; 2058 var 2059 i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer; 2019 2060 MaxTextLen: integer; {Max num of chars per line in pixels} 2020 2061 MaxChars: integer; {Max num of chars per line} … … 2022 2063 ctrl: TControl; 2023 2064 LastLineBlank: boolean; 2065 sLbl: TCPRSDialogStaticLabel; 2066 nLbl: TVA508ChainedLabel; 2067 sLblHeight: integer; 2068 TabOrdr: integer; 2069 2024 2070 const 2025 2071 FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't 2026 2072 overlay the focus rect on its parent panel.} 2073 2074 procedure Add2TabOrder(ctrl: TWinControl); 2075 begin 2076 ctrl.TabOrder := TabOrdr; 2077 inc(TabOrdr); 2078 end; 2079 2080 function StripSRCode(var txt: string; code: string; len: integer): integer; 2081 begin 2082 Result := pos(code, txt); 2083 if Result > 0 then 2084 begin 2085 delete(txt,Result,len); 2086 dec(Result); 2087 end 2088 else 2089 Result := -1; 2090 end; 2091 2027 2092 procedure DoLabel(Atxt: string); 2028 2093 var 2029 lbl: TLabel; 2030 2031 begin 2032 lbl := TLabel.Create(nil); 2033 lbl.Parent := FPanel; 2034 lbl.ShowAccelChar := FALSE; 2035 lbl.Caption := Atxt; 2036 lbl.Left := x; 2037 lbl.Top := y; 2038 inc(x, lbl.Width); 2039 end; 2040 2041 procedure NextLine; 2042 begin 2043 if(MaxX < x) then 2044 MaxX := x; 2045 x := FOCUS_RECT_MARGIN; {leave two pixels on the left for the Focus Rect} 2046 inc(y, yinc); 2047 yinc := ybase; 2048 end; 2049 2050 begin 2051 MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel} 2052 if(FFirstBuild or (FPanel.Width <> MaxLen)) then 2094 ctrl: TControl; 2095 tempLbl: TVA508ChainedLabel; 2096 2097 begin 2098 if ScreenReaderSystemActive then 2099 begin 2100 if assigned(sLbl) then 2101 begin 2102 tempLbl := TVA508ChainedLabel.Create(nil); 2103 if assigned(nLbl) then 2104 nLbl.NextLabel := tempLbl 2105 else 2106 sLbl.NextLabel := tempLbl; 2107 nLbl := tempLbl; 2108 ctrl := nLbl; 2109 end 2110 else 2111 begin 2112 sLbl := TCPRSDialogStaticLabel.Create(nil); 2113 ctrl := sLbl; 2114 end; 2115 end 2116 else 2117 ctrl := TLabel.Create(nil); 2118 SetOrdProp(ctrl, ShowAccelCharProperty, ord(FALSE)); 2119 SetStrProp(ctrl, CaptionProperty, Atxt); 2120 ctrl.Parent := FPanel; 2121 ctrl.Left := x; 2122 ctrl.Top := y; 2123 if ctrl = sLbl then 2124 begin 2125 Add2TabOrder(sLbl); 2126 sLbl.Height := sLblHeight; 2127 ScreenReaderSystem_CurrentLabel(sLbl); 2128 end; 2129 if ScreenReaderSystemActive then 2130 ScreenReaderSystem_AddText(Atxt); 2131 UpdateColorsFor508Compliance(ctrl); 2132 inc(x, ctrl.Width); 2133 end; 2134 2135 procedure Init; 2136 var 2137 lbl : TLabel; 2053 2138 begin 2054 2139 if(FFirstBuild) then … … 2061 2146 //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2); AGP commentout line for 2062 2147 //reminder spacing 2063 ybase := FontHeightPixel(FFont.Handle) ;2148 ybase := FontHeightPixel(FFont.Handle) + 2; 2064 2149 yinc := ybase; 2065 2150 LastLineBlank := FALSE; 2151 sLbl := nil; 2152 nLbl := nil; 2153 TabOrdr := 0; 2154 if ScreenReaderSystemActive then 2155 begin 2156 ScreenReaderSystem_CurrentCheckBox(OwningCheckBox); 2157 lbl := TLabel.Create(nil); 2158 try 2159 lbl.Parent := FPanel; 2160 sLblHeight := lbl.Height + 2; 2161 finally 2162 lbl.Free; 2163 end; 2164 2165 end; 2166 end; 2167 2168 procedure Text508Work; 2169 var 2170 ContinueCode: boolean; 2171 begin 2172 if StripCode(txt, SR_BREAK) then 2173 begin 2174 ScreenReaderSystem_Stop; 2175 nLbl := nil; 2176 sLbl := nil; 2177 end; 2178 2179 ContinueCode := FALSE; 2180 while StripSRCode(txt, ScreenReaderContinueCode, ScreenReaderContinueCodeLen) >= 0 do 2181 ContinueCode := TRUE; 2182 while StripSRCode(txt, ScreenReaderContinueCodeOld, ScreenReaderContinueCodeOldLen) >= 0 do 2183 ContinueCode := TRUE; 2184 if ContinueCode then 2185 ScreenReaderSystem_Continue; 2186 end; 2187 2188 procedure Ctrl508Work(ctrl: TControl); 2189 var 2190 lbl: TCPRSTemplateFieldLabel; 2191 begin 2192 if (Ctrl is TCPRSTemplateFieldLabel) and (not (Ctrl is TCPRSDialogHyperlinkLabel)) then 2193 begin 2194 lbl := Ctrl as TCPRSTemplateFieldLabel; 2195 if trim(lbl.Caption) <> '' then 2196 begin 2197 ScreenReaderSystem_CurrentLabel(lbl); 2198 ScreenReaderSystem_AddText(lbl.Caption); 2199 end 2200 else 2201 begin 2202 lbl.TabStop := FALSE; 2203 ScreenReaderSystem_Stop; 2204 end; 2205 end 2206 else 2207 begin 2208 if ctrl is TWinControl then 2209 Add2TabOrder(TWinControl(ctrl)); 2210 if Supports(ctrl, ICPRSDialogComponent) then 2211 ScreenReaderSystem_CurrentComponent(ctrl as ICPRSDialogComponent); 2212 end; 2213 sLbl := nil; 2214 nLbl := nil; 2215 end; 2216 2217 procedure NextLine; 2218 begin 2219 if(MaxX < x) then 2220 MaxX := x; 2221 x := FOCUS_RECT_MARGIN; {leave two pixels on the left for the Focus Rect} 2222 inc(y, yinc); 2223 yinc := ybase; 2224 end; 2225 2226 begin 2227 MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel} 2228 if(FFirstBuild or (FPanel.Width <> MaxLen)) then 2229 begin 2230 Init; 2066 2231 for i := 0 to FControls.Count-1 do 2067 2232 begin 2068 2233 txt := FControls[i]; 2069 if(copy(txt,1,1) = EOL_MARKER) then 2234 if ScreenReaderSystemActive then 2235 Text508Work; 2236 if StripCode(txt,EOL_MARKER) then 2070 2237 begin 2071 2238 if((x <> 0) or LastLineBlank) then 2072 2239 NextLine; 2073 delete(txt,1,1);2074 2240 LastLineBlank := (txt = ''); 2075 2241 end; … … 2120 2286 if(assigned(ctrl)) then 2121 2287 begin 2288 if ScreenReaderSystemActive then 2289 Ctrl508Work(ctrl); 2122 2290 idx := FIndents.IndexOfObject(Ctrl); 2123 2291 if idx >= 0 then … … 2137 2305 inc(x, Ctrl.Width + 4); 2138 2306 if yinc <= Ctrl.Height then 2139 yinc := Ctrl.Height + 1;2307 yinc := Ctrl.Height + 2; 2140 2308 if (x < MaxLen) and ((Ctrl is TRichEdit) or 2141 2309 ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then … … 2150 2318 if(FFieldValues <> '') then 2151 2319 SetFieldValues(FFieldValues); 2320 if ScreenReaderSystemActive then 2321 ScreenReaderSystem_Stop; 2152 2322 Result := FPanel; 2153 2323 end; … … 2162 2332 i, idx: integer; 2163 2333 obj: TObject; 2334 max: integer; 2164 2335 2165 2336 begin 2166 2337 if(assigned(FPanel)) then 2167 2338 begin 2168 for i := FPanel.ControlCount-1 downto 0 do 2169 if(FPanel.Controls[i] is TLabel) then 2339 max := FPanel.ControlCount-1; 2340 for i := max downto 0 do 2341 begin 2342 // deleting TVA508StaticText can delete several TVA508ChainedLabel components 2343 if i < FPanel.ControlCount then 2170 2344 begin 2171 2345 obj := FPanel.Controls[i]; 2172 idx := FControls.IndexOfObject(obj); 2173 if idx < 0 then 2174 obj.Free; 2175 end; 2346 if (not (obj is TVA508ChainedLabel)) and 2347 ((obj is TLabel) or (obj is TVA508StaticText)) then 2348 begin 2349 idx := FControls.IndexOfObject(obj); 2350 if idx < 0 then 2351 obj.Free; 2352 end; 2353 end; 2354 end; 2176 2355 end; 2177 2356 end; … … 2188 2367 M.Data := Self; 2189 2368 M.Code := @PanelDestroy; 2190 TFieldPanel(FPanel).OnDestroy := TNotifyEvent(M);2369 FPanel.OnDestroy := TNotifyEvent(M); 2191 2370 end 2192 2371 else 2193 TFieldPanel(FPanel).OnDestroy := nil;2372 FPanel.OnDestroy := nil; 2194 2373 end; 2195 2374 … … 2232 2411 begin 2233 2412 Done := FALSE; 2413 TORCheckBox(Ctrl).Checked := FALSE; //<-PSI-06-170-ADDED THIS LINE - v27.23 - RV 2234 2414 if(cnt = 0) then 2235 2415 cnt := DelimCount(AText, '|') + 1; … … 2278 2458 end; 2279 2459 2460 function TTemplateDialogEntry.StripCode(var txt: string; code: char): boolean; 2461 var 2462 p: integer; 2463 begin 2464 p := pos(code, txt); 2465 Result := (p > 0); 2466 if Result then 2467 begin 2468 while p > 0 do 2469 begin 2470 delete(txt, p, 1); 2471 p := pos(code, txt); 2472 end; 2473 end; 2474 end; 2475 2280 2476 procedure TTemplateDialogEntry.UpDownChange(Sender: TObject); 2281 2477 begin 2282 2478 EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag)); 2283 2479 DoChange(Sender); 2284 end;2285 2286 { TFieldPanel }2287 2288 destructor TFieldPanel.Destroy;2289 begin2290 if(assigned(FOnDestroy)) then2291 FOnDestroy(Self);2292 inherited;2293 end;2294 2295 {intercept the paint event to draw the focus rect if FFocused is true}2296 function TFieldPanel.GetFocus: boolean;2297 begin2298 result := Focused;2299 end;2300 2301 procedure TFieldPanel.Paint;2302 var2303 DC: HDC;2304 R: TRect;2305 2306 begin2307 inherited;2308 if(Focused) then2309 begin2310 if(not assigned(FCanvas)) then2311 FCanvas := TControlCanvas.Create;2312 DC := GetWindowDC(Handle);2313 try2314 FCanvas.Handle := DC;2315 R := ClientRect;2316 InflateRect(R, -1, -1);2317 FCanvas.DrawFocusRect(R);2318 finally2319 ReleaseDC(Handle, DC);2320 end;2321 end;2322 end;2323 2324 procedure TFieldPanel.SetTheFocus(const Value: boolean);2325 begin2326 if Value then2327 SetFocus;2328 end;2329 2330 { TWebLabel }2331 2332 procedure TWebLabel.Clicked(Sender: TObject);2333 begin2334 GotoWebPage(FAddr);2335 end;2336 2337 procedure TWebLabel.Init(Addr: string);2338 begin2339 FAddr := Addr;2340 OnClick := Clicked;2341 Font.Assign(TORExposedControl(Parent).Font);2342 Font.Color := clActiveCaption;2343 Font.Style := Font.Style + [fsUnderline];2344 AdjustBounds; // make sure we have the right width2345 AutoSize := FALSE;2346 Height := Height + 1; // Courier New doesn't support underline unless it's higher2347 Cursor := crHandPoint;2348 2480 end; 2349 2481 … … 2371 2503 end; 2372 2504 2505 procedure StripScreenReaderCodes(var Text: string); 2506 var 2507 p, j: integer; 2508 begin 2509 for j := low(ScreenReaderCodes) to high(ScreenReaderCodes) do 2510 begin 2511 p := 1; 2512 while (p > 0) do 2513 begin 2514 p := posex(ScreenReaderCodes[j], Text, p); 2515 if p > 0 then 2516 delete(Text, p, ScreenReaderCodeLens[j]); 2517 end; 2518 end; 2519 end; 2520 2521 procedure StripScreenReaderCodes(SL: TStrings); 2522 var 2523 temp: string; 2524 i: integer; 2525 2526 begin 2527 for i := 0 to SL.Count - 1 do 2528 begin 2529 temp := SL[i]; 2530 StripScreenReaderCodes(temp); 2531 SL[i] := temp; 2532 end; 2533 end; 2534 2535 function HasScreenReaderBreakCodes(SL: TStrings): boolean; 2536 var 2537 i: integer; 2538 2539 begin 2540 Result := TRUE; 2541 for i := 0 to SL.Count - 1 do 2542 begin 2543 if pos(ScreenReaderCodeSignature, SL[i]) > 0 then 2544 exit; 2545 end; 2546 Result := FALSE; 2547 end; 2548 2373 2549 initialization 2374 2550 -
cprs/trunk/CPRS-Chart/Templates/uTemplates.pas
r456 r829 253 253 function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string; overload; 254 254 function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string; 255 procedure UpdatePersonalObjects; 256 procedure SetTemplateDialogCanceled(value: Boolean); 257 function WasTemplateDialogCanceled: Boolean; 258 procedure SetTemplateBPHasObjects(value: Boolean); 259 function TemplateBPHasObjects: Boolean; 255 260 256 261 const … … 278 283 ConsultsTemplate: TTemplate = nil; 279 284 ProceduresTemplate: TTemplate = nil; 285 uPersonalObjects: TStringList = nil; // -------- CQ #8665 - RV ------------ 280 286 281 287 implementation … … 283 289 uses 284 290 Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields, 285 XMLUtils, fTemplateImport, Word97, uSpell, rCore, uConst, ORCtrls, uEventHooks, 286 fReminderDialog, rODBase; 291 XMLUtils, fTemplateImport, uSpell, rCore, uConst, ORCtrls, uEventHooks, 292 fReminderDialog, rODBase 293 {$IFDEF VER140} 294 , Word97; 295 {$ELSE} 296 , WordXP, VAUtils; 297 {$ENDIF} 287 298 288 299 const … … 311 322 uDGroupConsults: integer = 0; 312 323 uDGroupProcedures: integer = 0; 324 uTemplateDialogCanceled: Boolean = FALSE; 325 uTemplateBPHasObjects: Boolean = FALSE; 313 326 314 327 type … … 531 544 try 532 545 GetTemplateRoots; 533 TmpSL.Assign(RPCBrokerV.Results);546 FastAssign(RPCBrokerV.Results, TmpSL); 534 547 for i := 0 to TmpSL.Count-1 do 535 548 AddTemplate(TmpSL[i]); … … 559 572 try 560 573 GetTemplateChildren(tmpl.FID); 561 TmpSL.Assign(RPCBrokerV.Results);574 FastAssign(RPCBrokerV.Results, TmpSL); 562 575 for i := 0 to TmpSL.Count-1 do 563 576 AddTemplate(TmpSL[i], tmpl); … … 597 610 TempSL := nil; 598 611 end; 612 // -------- CQ #8665 - RV ------------ 613 if (assigned(uPersonalObjects)) then 614 begin 615 KillObj(@uPersonalObjects); 616 uPersonalObjects.Free; 617 uPersonalObjects := nil; 618 end; 619 // ------end CQ #8665 ------------ 599 620 if(assigned(Deleted)) then 600 621 begin … … 721 742 begin 722 743 if(assigned(Errors)) then 723 ShowM essage(Errors.text)744 ShowMsg(Errors.text) 724 745 else 725 ShowM essage(SingleError);746 ShowMsg(SingleError); 726 747 end; 727 748 … … 865 886 else 866 887 DescSL.Add('5,1=@'); 867 TempSL.AddStrings(DescSL)888 FastAddStrings(DescSL, TempSL) 868 889 finally 869 890 DescSL.Free; … … 1173 1194 WApp.Connect; 1174 1195 TmpVar := AFileName; 1196 {$IFDEF VER140} 1175 1197 WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam)); 1198 {$ELSE} 1199 WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam, EmptyParam, EmptyParam)); 1200 {$ENDIF} 1176 1201 ffTotal := WDoc.FormFields.Count; 1177 1202 … … 1307 1332 if tmp <> '' then 1308 1333 AddField(tfDefault, tmp); 1309 F ields.AddStrings(PendingAdd);1334 FastAddStrings(PendingAdd, Fields); 1310 1335 PendingAdd.Clear; 1311 1336 AddFieldHeader(tmpType, FALSE); … … 1396 1421 begin 1397 1422 Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">'; 1398 Data.AddStrings(Fields);1423 FastAddStrings(Fields, Data); 1399 1424 end; 1400 1425 end; … … 1486 1511 1487 1512 begin 1513 SetTemplateDialogCanceled(FALSE); 1514 SetTemplateBPHasObjects(FALSE); 1488 1515 Template := GetLinkedTemplate(IntToStr(IEN), LType); 1489 1516 if assigned(Template) then … … 1878 1905 try 1879 1906 TmpSL.Text := FullBoilerPlate; 1907 if Pos('|', TmpSL.Text) > 0 then SetTemplateBPHasObjects(TRUE); 1880 1908 finally 1881 1909 if(IsDialog) then … … 2550 2578 dmodShared.OnTemplateLock(Self) 2551 2579 else 2552 ShowM essage(Format(TemplateLockedText, [FPrintName]));2580 ShowMsg(Format(TemplateLockedText, [FPrintName])); 2553 2581 end; 2554 2582 end … … 2875 2903 end; 2876 2904 2905 // -------- CQ #8665 - RV ------------ 2906 procedure UpdatePersonalObjects; 2907 var 2908 i: integer; 2909 begin 2910 if not assigned(uPersonalObjects) then 2911 begin 2912 uPersonalObjects := TStringList.Create; 2913 GetAllowedPersonalObjects; 2914 for i := 0 to RPCBrokerV.Results.Count-1 do 2915 uPersonalObjects.Add(Piece(RPCBrokerV.Results[i],U,1)); 2916 uPersonalObjects.Sorted := TRUE; 2917 end; 2918 end; 2919 // -----end CQ #8665 ------------ 2920 2921 2922 procedure SetTemplateDialogCanceled(value: Boolean); 2923 begin 2924 uTemplateDialogCanceled := value; 2925 end; 2926 2927 function WasTemplateDialogCanceled: Boolean; 2928 begin 2929 Result := uTemplateDialogCanceled; 2930 end; 2931 2932 procedure SetTemplateBPHasObjects(value: Boolean); 2933 begin 2934 uTemplateBPHasObjects := value; 2935 end; 2936 2937 function TemplateBPHasObjects: Boolean; 2938 begin 2939 Result := uTemplateBPHasObjects; 2940 end; 2941 2877 2942 initialization 2878 2943 2879 2944 finalization 2880 2945 ReleaseTemplates; 2881 2882 2946 end. 2947 -
cprs/trunk/CPRS-Lib/ORCtrls.pas
r456 r829 7 7 uses Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Forms, 8 8 ComCtrls, Commctrl, Buttons, ExtCtrls, Grids, ImgList, Menus, CheckLst, 9 Accessibility_TLB, Variants;9 Variants, VAClasses; 10 10 11 11 const … … 21 21 22 22 type 23 24 TORStaticText = class(TStaticText) 25 private 26 FOnEnter: TNotifyEvent; 27 FOnExit: TNotifyEvent; 28 published 29 property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; 30 property OnExit: TNotifyEvent read FOnExit write FOnExit; 31 procedure DoEnter; override; 32 procedure DoExit; override; 23 IORBlackColorModeCompatible = interface(IInterface) 24 ['{3554985C-F524-45FA-8C27-4CDD8357DB08}'] 25 procedure SetBlackColorMode(Value: boolean); 33 26 end; 34 27 … … 81 74 end; 82 75 83 TORListBox = class(TListBox )76 TORListBox = class(TListBox, IVADynamicProperty, IORBlackColorModeCompatible) 84 77 private 85 78 FFocusIndex: Integer; // item with focus when using navigation keys … … 127 120 FMItems: TORStrings; // Used to save corresponding M strings ("the pieces") 128 121 FCaption: TStaticText; // Used to supply a title to IAccessible interface 129 FAccessible: IAccessible;130 122 FCaseChanged: boolean; // If true, the names are stored in the database as all caps, but loaded and displayed in mixed-case 131 123 FLookupPiece: integer; // If zero, list look-up comes from display string; if non-zero, indicates which piece of the item needs to be used for list lookup 132 procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT; 124 FIsPartOfComboBox: boolean; 125 FBlackColorMode: boolean; 126 FHideSelection: boolean; 133 127 procedure AdjustScrollBar; 134 128 procedure CreateScrollBar; … … 214 208 procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; 215 209 function GetIndexFromY(YPos :integer) :integer; 210 property isPartOfComboBox: boolean read FIsPartOfComboBox write FIsPartOfComboBox default False; 216 211 property HideSynonyms: boolean read FHideSynonyms write SetHideSynonyms default FALSE; 217 212 property SynonymChars: string read FSynonymChars write SetSynonymChars; … … 241 236 property CheckedState[Index: Integer]: TCheckBoxState read GetCheckedState write SetCheckedState; 242 237 property MItems: TStrings read GetMItems write SetMItems; 243 procedure MakeAccessible(Accessible: IAccessible);244 238 function VerifyUnique(SelectIndex: Integer; iText: String): integer; 239 procedure SetBlackColorMode(Value: boolean); 240 function SupportsDynamicProperty(PropertyID: integer): boolean; 241 function GetDynamicProperty(PropertyID: integer): string; 242 property HideSelection: boolean read FHideSelection write FHideSelection; 245 243 published 246 244 property AllowGrayed: boolean read FAllowGrayed write FAllowGrayed default FALSE; … … 303 301 end; 304 302 305 TORComboBox = class(TWinControl )303 TORComboBox = class(TWinControl, IVADynamicProperty, IORBlackColorModeCompatible) 306 304 private 307 305 FItems: TStrings; // points to Items in FListBox … … 340 338 FCharsNeedMatch: integer; // how many text need to be matched for auto selection 341 339 FUniqueAutoComplete: Boolean; // If true only perform autocomplete for unique list items. 340 FBlackColorMode: boolean; 341 FDisableHints: boolean; // true if hints have been disabled because drop down window was opened 342 FDropDownStatusChangedCount: integer; // prevents multiple calls to disabling hint window 343 procedure DropDownStatusChanged(opened: boolean); 344 procedure ClearDropDownStatus; 342 345 function EditControl: TWinControl; 343 346 procedure AdjustSizeOfSelf; … … 440 443 procedure SetLookupPiece(const Value: integer); 441 444 procedure SetUniqueAutoComplete(const Value: Boolean); 445 procedure LoadComboBoxImage; 442 446 protected 443 447 procedure DropPanelBtnPressed(OKBtn, AutoClose: boolean); … … 452 456 public 453 457 constructor Create(AOwner: TComponent); override; 458 destructor Destroy; override; 454 459 function AddReference(const S: string; AReference: Variant): Integer; 455 460 procedure Clear; … … 458 463 procedure InitLongList(S: string); 459 464 procedure InsertSeparator; 465 procedure Invalidate; override; 460 466 procedure SetTextAutoComplete(TextToMatch : String); 461 467 function GetIEN(AnIndex: Integer): Int64; … … 466 472 procedure InsertReference(Index: Integer; const S: string; AReference: Variant); 467 473 procedure SelectAll; 468 function MakeAccessible( Accessible: IAccessible): TORListBox; 474 procedure SetBlackColorMode(Value: boolean); 475 function SupportsDynamicProperty(PropertyID: integer): boolean; 476 function GetDynamicProperty(PropertyID: integer): string; 469 477 property DisplayText[Index: Integer]: string read GetDisplayText; 470 478 property DroppedDown: Boolean read FDroppedDown write SetDroppedDown; … … 648 656 649 657 650 TCaptionTreeView = class(TTreeView )658 TCaptionTreeView = class(TTreeView, IVADynamicProperty) 651 659 private 652 660 procedure SetCaption(const Value: string); … … 654 662 protected 655 663 FCaptionComponent: TStaticText; 664 public 665 function SupportsDynamicProperty(PropertyID: integer): boolean; 666 function GetDynamicProperty(PropertyID: integer): string; 656 667 published 657 668 property Align; … … 665 676 FTag: integer; 666 677 FStringData: string; 667 FAccessible: IAccessible;668 678 FCaption: string; 669 procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;670 679 function GetParent: TORTreeNode; 671 680 procedure SetCaption(const Value: string); … … 679 688 function GetORTreeView: TORTreeView; 680 689 public 681 procedure MakeAccessible(Accessible: IAccessible);682 690 procedure SetPiece(PieceNum: Integer; const NewPiece: string); 683 691 procedure EnsureVisible; 684 property Accessible: IAccessible read FAccessible write MakeAccessible;685 692 property Bold: boolean read GetBold write SetBold; 686 693 property Tag: integer read FTag write FTag; … … 700 707 FPiece: integer; 701 708 FOnAddition: TTVExpandedEvent; 702 FAccessible: IAccessible;703 709 FShortNodeCaptions: boolean; 704 710 FOnNodeCaptioning: TNodeCaptioningEvent; 705 procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;706 711 procedure SetShortNodeCaptions(const Value: boolean); 707 712 protected … … 716 721 public 717 722 constructor Create(AOwner: TComponent); override; 718 procedure MakeAccessible(Accessible: IAccessible);719 723 function FindPieceNode(Value: string; 720 724 ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload; … … 776 780 TGrayedStyle = (gsNormal, gsQuestionMark, gsBlueQuestionMark); 777 781 778 TORCheckBox = class(TCheckBox )782 TORCheckBox = class(TCheckBox, IORBlackColorModeCompatible) 779 783 private 780 784 FStringData: string; … … 793 797 FAssociate: TControl; 794 798 FFocusOnBox: boolean; 799 FBlackColorMode: boolean; 795 800 procedure SetFocusOnBox(value: boolean); 796 801 procedure CNMeasureItem (var Message: TWMMeasureItem); message CN_MEASUREITEM; … … 835 840 destructor Destroy; override; 836 841 procedure AutoAdjustSize; 842 procedure SetBlackColorMode(Value: boolean); 837 843 property SingleLine: boolean read FSingleLine; 838 844 property StringData: string read FStringData write FStringData; … … 899 905 end; 900 906 901 TCaptionListBox = class(TListBox )907 TCaptionListBox = class(TListBox, IVADynamicProperty) 902 908 private 903 909 FHoverItemPos: integer; 904 FAccessible: IAccessible;905 910 FRightClickSelect: boolean; // When true, a right click selects teh item 906 911 FHintOnItem: boolean; 907 912 procedure SetCaption(const Value: string); 908 913 function GetCaption: string; 909 procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;910 914 procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; 911 915 procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE; 916 procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; 917 procedure MoveFocusDown; 918 procedure MoveFocusUp; 912 919 protected 913 920 FCaptionComponent: TStaticText; 914 921 procedure DoEnter; override; 915 922 public 916 procedure MakeAccessible( Accessible: IAccessible); 923 function SupportsDynamicProperty(PropertyID: integer): boolean; 924 function GetDynamicProperty(PropertyID: integer): string; 917 925 published 918 926 property RightClickSelect: boolean read FRightClickSelect write FRightClickSelect default FALSE; … … 922 930 end; 923 931 924 TCaptionCheckListBox = class(TCheckListBox )932 TCaptionCheckListBox = class(TCheckListBox, IVADynamicProperty) 925 933 private 926 934 procedure SetCaption(const Value: string); … … 928 936 protected 929 937 FCaptionComponent: TStaticText; 938 public 939 function SupportsDynamicProperty(PropertyID: integer): boolean; 940 function GetDynamicProperty(PropertyID: integer): string; 930 941 published 931 942 property Caption: string read GetCaption write SetCaption; 932 943 end; 933 944 934 TCaptionMemo = class(TMemo )945 TCaptionMemo = class(TMemo, IVADynamicProperty) 935 946 private 936 947 procedure SetCaption(const Value: string); … … 938 949 protected 939 950 FCaptionComponent: TStaticText; 951 public 952 function SupportsDynamicProperty(PropertyID: integer): boolean; 953 function GetDynamicProperty(PropertyID: integer): string; 940 954 published 941 955 property Caption: string read GetCaption write SetCaption; 942 956 end; 943 957 944 TCaptionEdit = class(TEdit )958 TCaptionEdit = class(TEdit, IVADynamicProperty) 945 959 private 946 960 procedure SetCaption(const Value: string); … … 948 962 protected 949 963 FCaptionComponent: TStaticText; 964 public 965 function SupportsDynamicProperty(PropertyID: integer): boolean; 966 function GetDynamicProperty(PropertyID: integer): string; 950 967 published 951 968 property Align; … … 953 970 end; 954 971 955 TCaptionRichEdit = class(TRichEdit )972 TCaptionRichEdit = class(TRichEdit, IVADynamicProperty) 956 973 private 957 FAccessible: IAccessible;958 procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;959 974 protected 960 975 FCaption: string; 961 976 public 962 procedure MakeAccessible(Accessible: IAccessible); 977 function SupportsDynamicProperty(PropertyID: integer): boolean; 978 function GetDynamicProperty(PropertyID: integer): string; 963 979 published 964 980 property Align; … … 966 982 end; 967 983 968 TCaptionComboBox = class(TComboBox )984 TCaptionComboBox = class(TComboBox, IVADynamicProperty) 969 985 private 970 986 procedure SetCaption(const Value: string); … … 972 988 protected 973 989 FCaptionComponent: TStaticText; 990 public 991 function SupportsDynamicProperty(PropertyID: integer): boolean; 992 function GetDynamicProperty(PropertyID: integer): string; 974 993 published 975 994 property Caption: string read GetCaption write SetCaption; 976 995 end; 977 996 978 TCaptionListView = class(TListView) 997 TCaptionListView = class(TListView, IVADynamicProperty) 998 public 999 function SupportsDynamicProperty(PropertyID: integer): boolean; 1000 function GetDynamicProperty(PropertyID: integer): string; 979 1001 published 980 1002 property Caption; 981 1003 end; 982 1004 983 TCaptionStringGrid = class(TStringGrid )1005 TCaptionStringGrid = class(TStringGrid, IVADynamicProperty) 984 1006 private 985 1007 FJustToTab: boolean; 986 1008 FCaption: string; 987 FAccessible: IAccessible;988 procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;989 1009 protected 990 1010 procedure KeyUp(var Key: Word; Shift: TShiftState); override; 991 1011 public 992 procedure MakeAccessible( Accessible: IAccessible);993 1012 procedure IndexToColRow( index: integer; var Col: integer; var Row: integer); 994 1013 function ColRowToIndex( Col: integer; Row: Integer): integer; 1014 function SupportsDynamicProperty(PropertyID: integer): boolean; 1015 function GetDynamicProperty(PropertyID: integer): string; 995 1016 published 996 1017 property Caption: string read FCaption write FCaption; … … 1015 1036 1016 1037 uses 1017 uAccessAPI;1038 VAUtils; 1018 1039 1019 1040 const … … 1424 1445 'ORCB_RADIO_DISABLED_UNCHECKED', 'ORCB_RADIO_DISABLED_CHECKED'); 1425 1446 1426 var 1427 ORCBImages: array[TORCBImgIdx] of TBitMap; 1428 1429 function GetORCBBitmap(Idx: TORCBImgIdx): TBitmap; 1430 begin 1431 if(not assigned(ORCBImages[Idx])) then 1432 begin 1433 ORCBImages[Idx] := TBitMap.Create; 1434 ORCBImages[Idx].LoadFromResourceName(HInstance, CheckBoxImageResNames[Idx]); 1435 end; 1436 Result := ORCBImages[Idx]; 1447 BlackCheckBoxImageResNames: array[TORCBImgIdx] of PChar = ( 1448 'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED', 1449 'BLACK_ORCB_QUESTIONMARK', 'BLACK_ORCB_BLUEQUESTIONMARK', 1450 'BLACK_ORCB_DISABLED_UNCHECKED', 'BLACK_ORCB_DISABLED_CHECKED', 1451 'BLACK_ORCB_DISABLED_GRAYED', 'BLACK_ORCB_DISABLED_QUESTIONMARK', 1452 'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED', 1453 'BLACK_ORCB_RADIO_UNCHECKED', 'BLACK_ORCB_RADIO_CHECKED', 1454 'BLACK_ORCB_RADIO_DISABLED_UNCHECKED', 'BLACK_ORCB_RADIO_DISABLED_CHECKED'); 1455 1456 var 1457 ORCBImages: array[TORCBImgIdx, Boolean] of TBitMap; 1458 1459 function GetORCBBitmap(Idx: TORCBImgIdx; BlackMode: boolean): TBitmap; 1460 var 1461 ResName: string; 1462 begin 1463 if(not assigned(ORCBImages[Idx, BlackMode])) then 1464 begin 1465 ORCBImages[Idx, BlackMode] := TBitMap.Create; 1466 if BlackMode then 1467 ResName := BlackCheckBoxImageResNames[Idx] 1468 else 1469 ResName := CheckBoxImageResNames[Idx]; 1470 ORCBImages[Idx, BlackMode].LoadFromResourceName(HInstance, ResName); 1471 end; 1472 Result := ORCBImages[Idx, BlackMode]; 1437 1473 end; 1438 1474 … … 1440 1476 var 1441 1477 i: TORCBImgIdx; 1478 mode: boolean; 1442 1479 1443 1480 begin 1444 1481 for i := low(TORCBImgIdx) to high(TORCBImgIdx) do 1445 1482 begin 1446 if(assigned(ORCBImages[i])) then 1447 ORCBImages[i].Free; 1448 end; 1449 end; 1450 1451 { TORStaticText } 1452 1453 procedure TORStaticText.DoEnter; 1454 begin 1455 inherited DoEnter; 1456 if Assigned(FOnEnter) then 1457 FOnEnter(Self); 1458 end; 1459 1460 procedure TORStaticText.DoExit; 1461 begin 1462 inherited DoExit; 1463 if Assigned(FOnExit) then 1464 FOnExit(Self); 1483 for Mode := false to true do 1484 begin 1485 if(assigned(ORCBImages[i, Mode])) then 1486 ORCBImages[i, Mode].Free; 1487 end; 1488 end; 1465 1489 end; 1466 1490 … … 1658 1682 FCaseChanged := TRUE; 1659 1683 FLookupPiece := 0; 1684 FIsPartOfComboBox := False; 1660 1685 end; 1661 1686 … … 1768 1793 SetString(Result, Buf, Len); 1769 1794 end; 1795 end; 1796 1797 function TORListBox.GetDynamicProperty(PropertyID: integer): string; 1798 begin 1799 if PropertyID = DynaPropAccesibilityCaption then 1800 Result := GetCaption 1801 else 1802 Result := ''; 1770 1803 end; 1771 1804 … … 2016 2049 case Message.CharCode of 2017 2050 VK_LBUTTON, VK_RETURN, VK_SPACE: 2018 if FocusIndex > -1 then 2019 begin 2020 if MultiSelect then 2051 begin 2052 if (FocusIndex < 0) and (CheckBoxes or MultiSelect) and (Count > 0) then // JNM - 508 compliance 2053 SetFocusIndex(0); 2054 if FocusIndex > -1 then 2021 2055 begin 2022 IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0)); 2023 Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex); 2024 end 2025 else Perform(LB_SETCURSEL, FocusIndex, 0); 2026 // Send WM_COMMAND here because LBN_SELCHANGE not triggered by LB_SETSEL 2027 // and LBN_SELCHANGE is what eventually triggers the Click event. 2028 // The LBN_SELCHANGE documentation implies we should send the control id, which is 2029 // 32 bits long, in the high word of WPARAM (16 bits). Since that won't work - we'll 2030 // try sending the item index instead. 2031 //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't 2032 //Allow the Checkbox state on the control to be updated 2033 if CheckBoxes then 2034 PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)) 2035 else 2036 SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)); 2056 if MultiSelect then 2057 begin 2058 IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0)); 2059 Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex); 2060 end 2061 else Perform(LB_SETCURSEL, FocusIndex, 0); 2062 // Send WM_COMMAND here because LBN_SELCHANGE not triggered by LB_SETSEL 2063 // and LBN_SELCHANGE is what eventually triggers the Click event. 2064 // The LBN_SELCHANGE documentation implies we should send the control id, which is 2065 // 32 bits long, in the high word of WPARAM (16 bits). Since that won't work - we'll 2066 // try sending the item index instead. 2067 //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't 2068 //Allow the Checkbox state on the control to be updated 2069 if CheckBoxes then 2070 PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)) 2071 else 2072 SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)); 2073 end; 2037 2074 end; 2038 2075 VK_PRIOR: SetFocusIndex(FocusIndex - FLargeChange); … … 2236 2273 begin 2237 2274 FLastItemIndex := ItemIndex; 2275 if (not isPartOfComboBox) and (ItemIndex <> -1) then 2276 SetFocusIndex(ItemIndex); 2238 2277 if Assigned(FOnChange) then FOnChange(Self); 2239 2278 end; … … 2248 2287 { if (Items.Count > 0) and (Not IsAMouseButtonDown()) and (ItemIndex = -1) then 2249 2288 SetFocusIndex(TopIndex);//ItemIndex := TopIndex; } 2289 if FHideSelection and (ItemIndex < 0) and (FFocusIndex >= 0) then 2290 ItemIndex := FFocusIndex; 2250 2291 inherited DoEnter; 2251 2292 end; 2252 2293 2253 2294 procedure TORListBox.DoExit; 2295 var 2296 SaveIndex: integer; 2254 2297 { make sure item tip is hidden for this listbox when focus shifts to something else } 2255 2298 begin 2299 if FHideSelection then 2300 begin 2301 SaveIndex := ItemIndex; 2302 ItemIndex := -1; 2303 FFocusIndex := SaveIndex; 2304 end; 2305 2256 2306 uItemTip.Hide; 2257 2307 FItemTipActive := False; … … 2321 2371 procedure TORListBox.KeyPress(var Key: Char); 2322 2372 begin 2373 {inherited KeyPress is changing the ' ' into #0, had to move conditional before inherited.} 2374 if (Key = ' ') then begin 2375 ToggleCheckBox(ItemIndex); 2376 {The space bar causes the focus to jump to an item in the list that starts with 2377 a space. Disable that function.} 2378 Key := #0; 2379 end; 2323 2380 inherited; 2324 if (Key = ' ') then ToggleCheckBox(ItemIndex);2325 2381 end; 2326 2382 … … 2459 2515 begin 2460 2516 if(FFlatCheckBoxes) then 2461 BMap := GetORCBBitmap(iiFlatUnChecked )2517 BMap := GetORCBBitmap(iiFlatUnChecked, FBlackColorMode) 2462 2518 else 2463 BMap := GetORCBBitmap(iiUnchecked );2519 BMap := GetORCBBitmap(iiUnchecked, FBlackColorMode); 2464 2520 end; 2465 2521 cbChecked: 2466 2522 begin 2467 2523 if(FFlatCheckBoxes) then 2468 BMap := GetORCBBitmap(iiFlatChecked )2524 BMap := GetORCBBitmap(iiFlatChecked, FBlackColorMode) 2469 2525 else 2470 BMap := GetORCBBitmap(iiChecked );2526 BMap := GetORCBBitmap(iiChecked, FBlackColorMode); 2471 2527 end; 2472 2528 else // cbGrayed: 2473 2529 begin 2474 2530 if(FFlatCheckBoxes) then 2475 BMap := GetORCBBitmap(iiFlatGrayed )2531 BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode) 2476 2532 else 2477 BMap := GetORCBBitmap(iiGrayed );2533 BMap := GetORCBBitmap(iiGrayed, FBlackColorMode); 2478 2534 end; 2479 2535 end; … … 2482 2538 begin 2483 2539 if(FFlatCheckBoxes) then 2484 BMap := GetORCBBitmap(iiFlatGrayed )2540 BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode) 2485 2541 else 2486 BMap := GetORCBBitmap(iiGrayed );2542 BMap := GetORCBBitmap(iiGrayed, FBlackColorMode); 2487 2543 end; 2488 2544 TmpR := Rect; … … 2584 2640 end; 2585 2641 end; // -- special long list processing - end 2642 if (Value = SFI_END) or (not (Value < Items.Count)) then Value := Items.Count - 1; 2586 2643 if (Value = SFI_TOP) or (Value < 0) then Value := 0; 2587 if (Value = SFI_END) or (not (Value < Items.Count)) then Value := Items.Count - 1;2588 2644 FFocusIndex := Value; 2589 ItemIndex := Value; 2645 if Focused or (not FHideSelection) then 2646 ItemIndex := Value; 2590 2647 if MultiSelect then Perform(LB_SETCARETINDEX, FFocusIndex, 0) // LPARAM=0, scrolls into view 2591 2648 else … … 2850 2907 end; 2851 2908 2909 function TORListBox.SupportsDynamicProperty(PropertyID: integer): boolean; 2910 begin 2911 Result := (PropertyID = DynaPropAccesibilityCaption); 2912 end; 2913 2852 2914 procedure TORListBox.SetHideSynonyms(Value :boolean); 2853 2915 var … … 2930 2992 Strings: TStringList; 2931 2993 i, Pos: Integer; 2932 ItemRec : PItemRec;2994 ItemRec, ItemRec2: PItemRec; 2933 2995 SaveListMode: Boolean; 2934 2996 RealVerify: Boolean; … … 2960 3022 begin 2961 3023 Pos := Items.AddObject(Strings[i], ItemRec^.UserObject); 2962 References[Pos] := ItemRec^.Reference; 3024 // CQ 11491 - Changing TabPositions, etc. was wiping out check box status. 3025 FFromSelf := True; 3026 ItemRec2 := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Pos, 0)); 3027 FFromSelf := False; 3028 if(assigned(ItemRec2)) then 3029 begin 3030 ItemRec2^.Reference := ItemRec^.Reference; 3031 ItemRec2^.CheckedState := ItemRec^.CheckedState; 3032 end; 2963 3033 end; 2964 3034 end; … … 3505 3575 end; 3506 3576 3577 procedure TORListBox.SetBlackColorMode(Value: boolean); 3578 begin 3579 FBlackColorMode := Value; 3580 end; 3581 3507 3582 procedure TORListBox.SetCaption(const Value: string); 3508 3583 begin … … 3527 3602 end; 3528 3603 3529 procedure TORListBox.MakeAccessible(Accessible: IAccessible); 3530 begin 3531 if Assigned(FAccessible) and Assigned(Accessible) then 3532 raise Exception.Create(Caption + ' List Box is already Accessible!') 3533 else 3534 FAccessible := Accessible; 3535 end; 3536 3537 procedure TORListBox.WMGetObject(var Message: TMessage); 3538 begin 3539 if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then 3540 Message.Result := GetLResult(Message.wParam, FAccessible) 3541 else 3542 inherited; 3604 // In Delphi 2006, hint windows will cause the TORComboBox drop down list to 3605 // move behind a Stay on Top form. Hints are also problematic with item tips in 3606 // the drop down list, so we disable them when ever a drop down list is open, 3607 // on all forms, not just stay on top forms. 3608 var 3609 uDropPanelOpenCount: integer = 0; 3610 uOldShowHintsSetting: boolean; 3611 3612 procedure DropDownPanelOpened; 3613 begin 3614 if uDropPanelOpenCount=0 then 3615 uOldShowHintsSetting := Application.ShowHint; 3616 Application.ShowHint := FALSE; 3617 inc(uDropPanelOpenCount); 3618 end; 3619 3620 procedure DropDownPanelClosed; 3621 begin 3622 dec(uDropPanelOpenCount); 3623 if uDropPanelOpenCount<=0 then 3624 begin 3625 uDropPanelOpenCount := 0; 3626 if not Application.ShowHint then 3627 Application.ShowHint := uOldShowHintsSetting 3628 end; 3543 3629 end; 3544 3630 … … 3690 3776 const 3691 3777 ComboBoxImages: array[boolean] of string = ('BMP_CBODOWN_DISABLED', 'BMP_CBODOWN'); 3692 3778 BlackComboBoxImages: array[boolean] of string = ('BLACK_BMP_CBODOWN_DISABLED', 'BLACK_BMP_CBODOWN'); 3779 3693 3780 procedure TORComboEdit.CreateParams(var Params: TCreateParams); 3694 3781 { sets a one line edit box to multiline style so the editing rectangle can be changed } … … 3740 3827 FCheckBoxEditColor := clBtnFace; 3741 3828 FListBox := TORListBox.Create(Self); 3829 FListBox.isPartOfComboBox := True; 3742 3830 FListBox.Parent := Self; 3743 3831 FListBox.TabStop := False; … … 3866 3954 end; 3867 3955 3956 procedure TORComboBox.DropDownStatusChanged(opened: boolean); 3957 begin 3958 if opened then 3959 begin 3960 if not FDropPanel.Visible then 3961 begin 3962 if FDropDownStatusChangedCount = 0 then 3963 begin 3964 FDisableHints := TRUE; 3965 DropDownPanelOpened; 3966 end; 3967 inc(FDropDownStatusChangedCount); 3968 end; 3969 end 3970 else 3971 begin 3972 dec(FDropDownStatusChangedCount); 3973 if FDropDownStatusChangedCount <= 0 then 3974 begin 3975 if FDisableHints then 3976 begin 3977 DropDownPanelClosed; 3978 FDisableHints := FALSE; 3979 end; 3980 FDropDownStatusChangedCount := 0; 3981 end; 3982 end; 3983 end; 3984 3985 procedure TORComboBox.ClearDropDownStatus; 3986 begin 3987 FDropDownStatusChangedCount := 1; 3988 DropDownStatusChanged(FALSE); 3989 end; 3990 3991 destructor TORComboBox.Destroy; 3992 begin 3993 ClearDropDownStatus; 3994 inherited; 3995 end; 3996 3868 3997 procedure TORComboBox.DoEnter; 3869 3998 {var … … 3902 4031 end; 3903 4032 inherited DoExit; 4033 end; 4034 4035 procedure TORComboBox.LoadComboBoxImage; 4036 var 4037 imageName: string; 4038 begin 4039 if assigned(FDropBtn) then 4040 begin 4041 if FBlackColorMode then 4042 imageName := BlackComboBoxImages[inherited Enabled] 4043 else 4044 imageName := ComboBoxImages[inherited Enabled]; 4045 FDropBtn.Glyph.LoadFromResourceName(hInstance, imageName); 4046 end; 3904 4047 end; 3905 4048 … … 4098 4241 4099 4242 procedure TORComboBox.FwdKeyPress(Sender: TObject; var Key: Char); 4243 var 4244 KeyCode: integer; 4100 4245 { prevents return from being used by editbox (otherwise sends a newline & text vanishes) } 4101 4246 begin 4102 // may want to make the tab beep if tab key (#9) - can't tab until list raised 4103 if (Key in [#9, #13]) or (FListBox.FCheckBoxes and (Key = #32)) then 4104 begin 4247 KeyCode := ord(Key); 4248 if (KeyCode = VK_RETURN) and (Style = orcsDropDown) and DroppedDown then 4249 begin 4250 DroppedDown := FALSE; 4105 4251 Key := #0; 4106 Exit; 4107 end; 4108 if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key); 4252 end 4253 else 4254 begin 4255 // may want to make the tab beep if tab key (#9) - can't tab until list raised 4256 if (KeyCode = VK_RETURN) or (KeyCode = VK_TAB) or (FListBox.FCheckBoxes and (KeyCode = VK_SPACE)) then 4257 begin 4258 Key := #0; 4259 Exit; 4260 end; 4261 if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key); 4262 end; 4109 4263 end; 4110 4264 … … 4168 4322 FCheckedState := FListBox.GetCheckedString; 4169 4323 end; 4324 DropDownStatusChanged(TRUE); 4170 4325 FDropPanel.Visible := True; 4171 4326 FDropPanel.BringToFront; … … 4178 4333 uItemTip.Hide; 4179 4334 FDropPanel.Hide; 4335 DropDownStatusChanged(FALSE); 4180 4336 if(FListBox.FCheckBoxes) and (assigned(FOnChange)) and 4181 4337 (FCheckedState <> FListBox.GetCheckedString) then … … 4265 4421 begin 4266 4422 if FDropBtn <> nil then FDropBtn.Free; 4267 if FDropPanel <> nil then FDropPanel.Free; 4423 if FDropPanel <> nil then 4424 begin 4425 ClearDropDownStatus; 4426 FDropPanel.Free; 4427 end; 4268 4428 FDropBtn := nil; 4269 4429 FDropPanel := nil; … … 4280 4440 if(assigned(FEditPanel) and (csDesigning in ComponentState)) then 4281 4441 FEditPanel.ControlStyle := FEditPanel.ControlStyle - [csAcceptsControls]; 4282 FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[inherited Enabled]); 4442 LoadComboBoxImage; 4443 // FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[inherited Enabled]); 4283 4444 FDropBtn.OnMouseDown := DropButtonDown; 4284 4445 FDropBtn.OnMouseUp := DropButtonUp; … … 4292 4453 FListBox.FParentCombo := Self; 4293 4454 FListBox.Parent := FDropPanel; 4455 ClearDropDownStatus; 4294 4456 if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := FDropPanel; // if long 4295 4457 end else … … 4328 4490 end; 4329 4491 4492 function TORComboBox.SupportsDynamicProperty(PropertyID: integer): boolean; 4493 begin 4494 Result := (PropertyID = DynaPropAccesibilityCaption); 4495 end; 4496 4330 4497 // Since TORComboBox is composed of several controls (FEditBox, FListBox, FDropBtn), the 4331 4498 // following functions and procedures map public and published properties to their related … … 4373 4540 end; 4374 4541 4542 procedure TORComboBox.Invalidate; 4543 begin 4544 inherited; 4545 FEditBox.Invalidate; 4546 FListBox.Invalidate; 4547 if assigned(FEditPanel) then 4548 FEditPanel.Invalidate; 4549 if assigned(FDropBtn) then 4550 FDropBtn.Invalidate; 4551 if assigned(FDropPanel) then 4552 FDropPanel.Invalidate; 4553 end; 4554 4375 4555 function TORComboBox.GetAutoSelect: Boolean; 4376 4556 begin … … 4393 4573 end; 4394 4574 4575 function TORComboBox.GetDynamicProperty(PropertyID: integer): string; 4576 begin 4577 if PropertyID = DynaPropAccesibilityCaption then 4578 Result := GetCaption 4579 else 4580 Result := ''; 4581 end; 4582 4395 4583 function TORComboBox.GetItemHeight: Integer; 4396 4584 begin … … 4516 4704 begin 4517 4705 FEditBox.AutoSelect := Value; 4706 end; 4707 4708 procedure TORComboBox.SetBlackColorMode(Value: boolean); 4709 begin 4710 if FBlackColorMode <> Value then 4711 begin 4712 FBlackColorMode := Value; 4713 FListBox.SetBlackColorMode(Value); 4714 LoadComboBoxImage; 4715 end; 4518 4716 end; 4519 4717 … … 4774 4972 if (inherited GetEnabled <> Value) then 4775 4973 begin 4974 DroppedDown := FALSE; 4776 4975 inherited SetEnabled(Value); 4777 4976 if assigned(FDropBtn) then 4778 FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[Value]); 4977 LoadComboBoxImage; 4978 // FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[Value]); 4779 4979 end; 4780 4980 end; … … 4837 5037 begin 4838 5038 result := FListBox.Caption; 4839 end;4840 4841 function TORComboBox.MakeAccessible(Accessible: IAccessible): TORListBox;4842 begin4843 FListBox.MakeAccessible(Accessible);4844 result := FListBox;4845 5039 end; 4846 5040 … … 5261 5455 ORCtrls.SetPiece(FStringData, FDelim, FPiece, Value); 5262 5456 end; 5263 end;5264 5265 procedure TORTreeNode.MakeAccessible(Accessible: IAccessible);5266 begin5267 if Assigned(FAccessible) and Assigned(Accessible) then5268 raise Exception.Create(Text + ' Tree Node is already Accessible!')5269 else5270 begin5271 FAccessible := Accessible;5272 end;5273 end;5274 5275 procedure TORTreeNode.WMGetObject(var Message: TMessage);5276 begin5277 if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then5278 Message.Result := GetLResult(Message.wParam, FAccessible)5279 else5280 inherited;5281 5457 end; 5282 5458 … … 5522 5698 else 5523 5699 Result := ''; 5524 end;5525 5526 procedure TORTreeView.MakeAccessible(Accessible: IAccessible);5527 begin5528 if Assigned(FAccessible) and Assigned(Accessible) then5529 raise Exception.Create(Text + ' Tree View is already Accessible!')5530 else5531 begin5532 FAccessible := Accessible;5533 end;5534 end;5535 5536 procedure TORTreeView.WMGetObject(var Message: TMessage);5537 begin5538 if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then5539 Message.Result := GetLResult(Message.wParam, FAccessible)5540 else5541 inherited;5542 5700 end; 5543 5701 … … 5908 6066 end; 5909 6067 end; 5910 Bitmap := GetORCBBitmap(ImgIdx );6068 Bitmap := GetORCBBitmap(ImgIdx, FBlackColorMode); 5911 6069 end 5912 6070 else … … 6050 6208 R.Top:= FocusRect.Top 6051 6209 else 6210 begin 6052 6211 R.Top:= ((ClientHeight - Bitmap.Height + 1) div 2) - 1; 6053 6212 if R.Top < 0 then R.Top := 0 6213 end; 6054 6214 Draw(R.Left, R.Top, Bitmap); 6055 6215 end; … … 6145 6305 end; 6146 6306 6307 procedure TORCheckBox.SetBlackColorMode(Value: boolean); 6308 begin 6309 if FBlackColorMode <> Value then 6310 begin 6311 FBlackColorMode := Value; 6312 Invalidate; 6313 end; 6314 end; 6315 6147 6316 procedure TORCheckBox.AutoAdjustSize; 6148 6317 var … … 6276 6445 if DoCtrl then 6277 6446 Ctrl.Enabled := Checked; 6278 if(Ctrl is TWinControl) then 6447 6448 // added (csAcceptsControls in Ctrl.ControlStyle) below to prevent disabling of 6449 // child sub controls, like the TBitBtn in the TORComboBox. If the combo box is 6450 // already disabled, we don't want to disable the button as well - when we do, we 6451 // lose the disabled glyph that is stored on that button for the combo box. 6452 6453 if(Ctrl is TWinControl) and (csAcceptsControls in Ctrl.ControlStyle) then 6279 6454 begin 6280 6455 for i := 0 to TWinControl(Ctrl).ControlCount-1 do … … 6500 6675 end; 6501 6676 6502 procedure TCaptionListBox.MakeAccessible(Accessible: IAccessible);6503 begin 6504 if Assigned(FAccessible) and Assigned(Accessible)then6505 raise Exception.Create(Caption + ' List Box is already Accessible!')6677 function TCaptionListBox.GetDynamicProperty(PropertyID: integer): string; 6678 begin 6679 if PropertyID = DynaPropAccesibilityCaption then 6680 Result := GetCaption 6506 6681 else 6507 FAccessible := Accessible; 6682 Result := ''; 6683 end; 6684 6685 6686 procedure TCaptionListBox.MoveFocusUp; 6687 begin 6688 if ItemIndex > 0 then 6689 Perform(LB_SETCARETINDEX, ItemIndex - 1, 0); 6690 end; 6691 6692 procedure TCaptionListBox.MoveFocusDown; 6693 begin 6694 if ItemIndex < (Items.Count-1) then 6695 Perform(LB_SETCARETINDEX, ItemIndex + 1, 0); 6508 6696 end; 6509 6697 … … 6522 6710 end; 6523 6711 6524 procedure TCaptionListBox.WMGetObject(var Message: TMessage); 6525 begin 6526 if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then 6527 Message.Result := GetLResult(Message.wParam, FAccessible) 6528 else 6529 inherited; 6712 function TCaptionListBox.SupportsDynamicProperty(PropertyID: integer): boolean; 6713 begin 6714 Result := (PropertyID = DynaPropAccesibilityCaption); 6715 end; 6716 6717 procedure TCaptionListBox.WMKeyDown(var Message: TWMKeyDown); 6718 var 6719 IsSelected: LongBool; 6720 begin 6721 if Boolean(Hi(GetKeyState(VK_CONTROL))) and MultiSelect then 6722 case Message.CharCode of 6723 VK_SPACE: 6724 begin 6725 IsSelected := LongBool(Perform(LB_GETSEL, ItemIndex, 0)); 6726 Perform(LB_SETSEL, Longint(not IsSelected), ItemIndex); 6727 end; 6728 VK_LEFT, VK_UP: MoveFocusUp; 6729 VK_RIGHT, VK_DOWN: MoveFocusDown; 6730 else inherited; 6731 end 6732 else inherited; 6530 6733 end; 6531 6734 … … 6591 6794 end; 6592 6795 6796 function TCaptionCheckListBox.GetDynamicProperty(PropertyID: integer): string; 6797 begin 6798 if PropertyID = DynaPropAccesibilityCaption then 6799 Result := GetCaption 6800 else 6801 Result := ''; 6802 end; 6803 6593 6804 procedure TCaptionCheckListBox.SetCaption(const Value: string); 6594 6805 begin … … 6605 6816 end; 6606 6817 6818 function TCaptionCheckListBox.SupportsDynamicProperty( 6819 PropertyID: integer): boolean; 6820 begin 6821 Result := (PropertyID = DynaPropAccesibilityCaption); 6822 end; 6823 6607 6824 { TCaptionMemo } 6608 6825 … … 6613 6830 else 6614 6831 result := FCaptionComponent.Caption; 6832 end; 6833 6834 function TCaptionMemo.GetDynamicProperty(PropertyID: integer): string; 6835 begin 6836 if PropertyID = DynaPropAccesibilityCaption then 6837 Result := GetCaption 6838 else 6839 Result := ''; 6615 6840 end; 6616 6841 … … 6629 6854 end; 6630 6855 6856 function TCaptionMemo.SupportsDynamicProperty(PropertyID: integer): boolean; 6857 begin 6858 Result := (PropertyID = DynaPropAccesibilityCaption); 6859 end; 6860 6631 6861 { TCaptionEdit } 6632 6862 … … 6637 6867 else 6638 6868 result := FCaptionComponent.Caption; 6869 end; 6870 6871 function TCaptionEdit.GetDynamicProperty(PropertyID: integer): string; 6872 begin 6873 if PropertyID = DynaPropAccesibilityCaption then 6874 Result := GetCaption 6875 else 6876 Result := ''; 6639 6877 end; 6640 6878 … … 6653 6891 end; 6654 6892 6893 function TCaptionEdit.SupportsDynamicProperty(PropertyID: integer): boolean; 6894 begin 6895 Result := (PropertyID = DynaPropAccesibilityCaption); 6896 end; 6897 6655 6898 { TCaptionRichEdit } 6656 6899 6657 procedure TCaptionRichEdit.MakeAccessible(Accessible: IAccessible);6658 begin 6659 if Assigned(FAccessible) and Assigned(Accessible)then6660 raise Exception.Create(Caption + ' Rich Edit is already Accessible!')6900 function TCaptionRichEdit.GetDynamicProperty(PropertyID: integer): string; 6901 begin 6902 if PropertyID = DynaPropAccesibilityCaption then 6903 Result := FCaption 6661 6904 else 6662 FAccessible := Accessible; 6663 end; 6664 6665 procedure TCaptionRichEdit.WMGetObject(var Message: TMessage); 6666 begin 6667 if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then 6668 Message.Result := GetLResult(Message.wParam, FAccessible) 6905 Result := ''; 6906 end; 6907 6908 6909 function TCaptionRichEdit.SupportsDynamicProperty(PropertyID: integer): boolean; 6910 begin 6911 Result := (PropertyID = DynaPropAccesibilityCaption); 6912 end; 6913 6914 { TCaptionTreeView} 6915 6916 function TCaptionTreeView.GetCaption: string; 6917 begin 6918 result := inherited Caption; 6919 end; 6920 6921 function TCaptionTreeView.GetDynamicProperty(PropertyID: integer): string; 6922 begin 6923 if PropertyID = DynaPropAccesibilityCaption then 6924 Result := GetCaption 6669 6925 else 6670 inherited; 6671 end; 6672 6673 { TCaptionTreeView} 6674 6675 function TCaptionTreeView.GetCaption: string; 6676 begin 6677 result := inherited Caption; 6926 Result := ''; 6678 6927 end; 6679 6928 … … 6693 6942 end; 6694 6943 6944 function TCaptionTreeView.SupportsDynamicProperty(PropertyID: integer): boolean; 6945 begin 6946 Result := (PropertyID = DynaPropAccesibilityCaption); 6947 end; 6948 6695 6949 { TCaptionComboBox } 6696 6950 … … 6701 6955 else 6702 6956 result := FCaptionComponent.Caption; 6957 end; 6958 6959 function TCaptionComboBox.GetDynamicProperty(PropertyID: integer): string; 6960 begin 6961 if PropertyID = DynaPropAccesibilityCaption then 6962 Result := GetCaption 6963 else 6964 Result := ''; 6703 6965 end; 6704 6966 … … 6717 6979 end; 6718 6980 6981 function TCaptionComboBox.SupportsDynamicProperty(PropertyID: integer): boolean; 6982 begin 6983 Result := (PropertyID = DynaPropAccesibilityCaption); 6984 end; 6985 6719 6986 { TORAlignSpeedButton } 6720 6987 … … 6742 7009 result := (ColCount - FixedCols) * (Row - FixedRows) + 6743 7010 (Col - FixedCols) + 1; 7011 end; 7012 7013 function TCaptionStringGrid.GetDynamicProperty(PropertyID: integer): string; 7014 begin 7015 if PropertyID = DynaPropAccesibilityCaption then 7016 Result := FCaption 7017 else 7018 Result := ''; 6744 7019 end; 6745 7020 … … 6761 7036 end; 6762 7037 6763 procedure TCaptionStringGrid.MakeAccessible(Accessible: IAccessible); 6764 begin 6765 if Assigned(FAccessible) and Assigned(Accessible) then 6766 raise Exception.Create(Caption + 'String Grid is already Accessible!') 6767 else 6768 FAccessible := Accessible; 6769 end; 6770 6771 procedure TCaptionStringGrid.WMGetObject(var Message: TMessage); 6772 begin 6773 if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then 6774 Message.Result := GetLResult(Message.wParam, FAccessible) 6775 else 6776 inherited; 7038 7039 function TCaptionStringGrid.SupportsDynamicProperty( 7040 PropertyID: integer): boolean; 7041 begin 7042 Result := (PropertyID = DynaPropAccesibilityCaption); 6777 7043 end; 6778 7044 … … 6810 7076 if LongList then 6811 7077 begin 6812 //Currently Do nothing for LongLists 6813 { if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then 6814 Result := -1;} 7078 //Implemented for CQ: 10092, PSI-04-057 7079 //asume long lists are alphabetically ordered... 7080 if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then 7081 Result := -1; 6815 7082 end 6816 7083 else //Not a LongList … … 6836 7103 end; 6837 7104 7105 { TCaptionListView } 7106 7107 function TCaptionListView.GetDynamicProperty(PropertyID: integer): string; 7108 begin 7109 if PropertyID = DynaPropAccesibilityCaption then 7110 Result := Caption 7111 else 7112 Result := ''; 7113 end; 7114 7115 function TCaptionListView.SupportsDynamicProperty(PropertyID: integer): boolean; 7116 begin 7117 Result := (PropertyID = DynaPropAccesibilityCaption); 7118 end; 7119 6838 7120 initialization 6839 7121 //uItemTip := TItemTip.Create(Application); // all listboxes share a single ItemTip window -
cprs/trunk/CPRS-Lib/ORCtrlsDsgn.pas
r456 r829 153 153 begin 154 154 RegisterComponents('CPRS', 155 [TOR StaticText, TORListBox, TORComboBox, TORAutoPanel, TOROffsetLabel, TORAlignEdit,155 [TORListBox, TORComboBox, TORAutoPanel, TOROffsetLabel, TORAlignEdit, 156 156 TORAlignButton, TORAlignSpeedButton, TORTreeView, TORCheckBox, TORListView, 157 157 TKeyClickPanel, TKeyClickRadioGroup, TCaptionListBox, TCaptionCheckListBox, -
cprs/trunk/CPRS-Lib/ORDtTm.dfm
r456 r829 1 1 object ORfrmDtTm: TORfrmDtTm 2 Left = 5 503 Top = 4 742 Left = 586 3 Top = 483 4 4 BorderIcons = [] 5 5 BorderStyle = bsDialog -
cprs/trunk/CPRS-Lib/ORDtTm.pas
r456 r829 7 7 uses 8 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, 9 Grids, Calendar, ExtCtrls, ORFn, ORNet, ORDtTmCal, Mask, ComCtrls, ORCtrls; 9 Grids, Calendar, ExtCtrls, ORFn, ORNet, ORDtTmCal, Mask, ComCtrls, OR2006Compatibility, 10 ORCtrls, VAClasses; 10 11 11 12 type 12 TORfrmDtTm = class(T Form)13 TORfrmDtTm = class(Tfrm2006Compatibility) 13 14 bvlFrame: TBevel; 14 15 lblDate: TPanel; … … 51 52 FNowPressed: Boolean; 52 53 TimeIsRequired: Boolean; 54 protected 55 procedure Loaded; override; 53 56 end; 54 57 … … 75 78 end; 76 79 80 // 508 class 81 TORDateButton = class (TBitBtn); 82 77 83 { TORDateBox } 78 84 … … 82 88 end; 83 89 84 TORDateBox = class(TORDateEdit )90 TORDateBox = class(TORDateEdit, IVADynamicProperty, IORBlackColorModeCompatible) 85 91 private 86 92 FFMDateTime: TFMDateTime; 87 93 FDateOnly: Boolean; 88 94 FRequireTime: Boolean; 89 FButton: T BitBtn;95 FButton: TORDateButton; 90 96 FFormat: string; 91 97 FTimeIsNow: Boolean; 92 98 FTemplateField: boolean; 93 99 FCaption: TStaticText; 100 FBlackColorMode: boolean; 94 101 procedure ButtonClick(Sender: TObject); 95 102 function GetFMDateTime: TFMDateTime; … … 104 111 procedure SetCaption(const Value: string); 105 112 function GetCaption(): string; 106 107 113 protected 108 114 procedure Change; override; 109 115 procedure KeyDown(var Key: Word; Shift: TShiftState); override; 116 property DateButton: TORDateButton read FButton; 110 117 public 111 118 constructor Create(AOwner: TComponent); override; 112 119 function IsValid: Boolean; 113 120 procedure Validate(var ErrMsg: string); 121 procedure SetBlackColorMode(Value: boolean); 122 function SupportsDynamicProperty(PropertyID: integer): boolean; 123 function GetDynamicProperty(PropertyID: integer): string; 114 124 property Format: string read FFormat write FFormat; 115 125 property RelativeTime: string read GetRelativeTime; … … 122 132 end; 123 133 124 TORDateCombo = class(TCustomPanel) 134 // 508 classes 135 TORDayCombo = class (TORComboBox); 136 TORMonthCombo = class (TORComboBox); 137 TORYearEdit = class(TMaskEdit) 138 private 139 FTemplateField: boolean; 140 procedure SetTemplateField(const Value: boolean); 141 protected 142 property TemplateField: boolean read FTemplateField write SetTemplateField; 143 end; 144 145 TORYearEditClass = Class of TORYearEdit; 146 147 TORDateCombo = class(TCustomPanel, IORBlackColorModeCompatible) 125 148 private 126 149 FYearChanging: boolean; 127 FMonthCombo: TOR ComboBox;128 FDayCombo: TOR ComboBox;129 FYearEdit: T MaskEdit;150 FMonthCombo: TORMonthCombo; 151 FDayCombo: TORDayCombo; 152 FYearEdit: TORYearEdit; 130 153 FYearUD: TUpDown; 131 FCalBtn: T SpeedButton;154 FCalBtn: TORDateButton; 132 155 FIncludeMonth: boolean; 133 156 FIncludeDay: boolean; … … 141 164 FRebuilding: boolean; 142 165 FTemplateField: boolean; 166 FBlackColorMode: boolean; 167 FORYearEditClass: TORYearEditClass; 143 168 procedure SetIncludeBtn(const Value: boolean); 144 169 procedure SetIncludeDay(Value: boolean); … … 153 178 procedure SetTemplateField(const Value: boolean); 154 179 protected 155 procedure Rebuild; 180 procedure Rebuild; virtual; 156 181 function InitDays(GetSize: boolean): integer; 157 182 function InitMonths(GetSize: boolean): integer; … … 169 194 procedure Paint; override; 170 195 procedure Resized(Sender: TObject); 196 property MonthCombo: TORMonthCombo read FMonthCombo; 197 property DayCombo: TORDayCombo read FDayCombo; 198 property YearEdit: TORYearEdit read FYearEdit; 199 property YearUD: TUpDown read FYearUD; 200 property CalBtn: TORDateButton read FCalBtn; 201 property ORYearEditClass: TORYearEditClass read FORYearEditClass write FORYearEditClass; 171 202 public 172 203 constructor Create(AOwner: TComponent); override; 173 204 destructor Destroy; override; 174 205 function DateText: string; 206 procedure SetBlackColorMode(Value: boolean); 175 207 property TemplateField: boolean read FTemplateField write SetTemplateField; 176 208 property FMDate: TFMDateTime read GetFMDate write SetFMDate; … … 280 312 end; 281 313 314 procedure LoadEllipsis(bitmap: TBitMap; BlackColorMode: boolean); 315 var 316 ResName: string; 317 begin 318 if BlackColorMode then 319 ResName := 'BLACK_BMP_ELLIPSIS' 320 else 321 ResName := 'BMP_ELLIPSIS'; 322 bitmap.LoadFromResourceName(hInstance, ResName); 323 end; 324 282 325 { TfrmORDtTm -------------------------------------------------------------------------------- } 283 326 … … 351 394 procedure TORfrmDtTm.lstHourClick(Sender: TObject); 352 395 begin 396 if lstHour.ItemIndex = 0 then lstMinute.Items[0] := ':01 --' else lstMinute.Items[0] := ':00 --'; //<------ NEW CODE 353 397 if lstMinute.ItemIndex < 0 then lstMinute.ItemIndex := 0; 354 398 lstMinuteClick(Self); … … 374 418 375 419 AMinute := lstMinute.ItemIndex * 5; 420 if (AnHour = 0) and (AMinute = 0) then AMinute := 1; //<-------------- NEW CODE 376 421 FFromSelf := True; 377 422 // if ampm time - … … 410 455 begin 411 456 x := Trim(txtTime.Text); 412 if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:00:01'; 457 //if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:00:01'; 458 if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:01'; //<------- CHANGED CODE 413 459 StrToTime(x); 414 460 txtTime.Text := x; … … 420 466 begin 421 467 ModalResult := mrCancel; 468 end; 469 470 procedure TORfrmDtTm.Loaded; 471 begin 472 inherited Loaded; 473 UpdateColorsFor508Compliance(Self); 422 474 end; 423 475 … … 515 567 begin 516 568 inherited Create(AOwner); 517 FButton := T BitBtn.Create(Self);569 FButton := TORDateButton.Create(Self); 518 570 FButton.Parent := Self; 519 571 FButton.Width := 18; … … 521 573 FButton.OnClick := ButtonClick; 522 574 FButton.TabStop := False; 523 FButton.Glyph.LoadFromResourceName(hInstance, 'BMP_ELLIPSIS'); 575 FBlackColorMode := False; 576 LoadEllipsis(FButton.Glyph, FALSE); 524 577 FButton.Visible := True; 525 578 FFormat := FMT_DATETIME; … … 567 620 end; 568 621 622 function TORDateBox.SupportsDynamicProperty(PropertyID: integer): boolean; 623 begin 624 Result := (PropertyID = DynaPropAccesibilityCaption); 625 end; 626 569 627 procedure TORDateBox.ButtonClick(Sender: TObject); 570 628 var … … 696 754 if Length(x) = 0 then Result := True else Result := False; 697 755 if Length(Text) = 0 then Result := False; 756 end; 757 758 procedure TORDateBox.SetBlackColorMode(Value: boolean); 759 begin 760 if FBlackColorMode <> Value then 761 begin 762 FBlackColorMode := Value; 763 LoadEllipsis(FButton.Glyph, FBlackColorMode); 764 end; 698 765 end; 699 766 … … 717 784 end; 718 785 786 function TORDateBox.GetDynamicProperty(PropertyID: integer): string; 787 begin 788 if PropertyID = DynaPropAccesibilityCaption then 789 Result := GetCaption 790 else 791 Result := ''; 792 end; 793 719 794 function IsLeapYear(AYear: Integer): Boolean; 720 795 begin … … 745 820 LastYear = 2200; 746 821 747 type748 TORDateComboEdit = class(TMaskEdit)749 private750 FTemplateField: boolean;751 procedure SetTemplateField(const Value: boolean);752 protected753 property TemplateField: boolean read FTemplateField write SetTemplateField;754 end;755 756 822 { TORDateComboEdit } 757 823 758 procedure TOR DateComboEdit.SetTemplateField(const Value: boolean);824 procedure TORYearEdit.SetTemplateField(const Value: boolean); 759 825 begin 760 826 if(FTemplateField <> Value) then … … 779 845 FIncludeBtn := TRUE; 780 846 OnResize := Resized; 847 FORYearEditClass := TORYearEdit; 781 848 end; 782 849 … … 868 935 if(not assigned(FMonthCombo)) then 869 936 begin 870 FMonthCombo := TOR ComboBox.Create(Self);937 FMonthCombo := TORMonthCombo.Create(Self); 871 938 FMonthCombo.Parent := Self; 872 939 FMonthCombo.Top := 0; … … 874 941 FMonthCombo.Style := orcsDropDown; 875 942 FMonthCombo.DropDownCount := 13; 943 FMonthCombo.ListItemsOnly := True; 876 944 FMonthCombo.OnChange := MonthChanged; 877 945 end; … … 888 956 if(not assigned(FDayCombo)) then 889 957 begin 890 FDayCombo := TOR ComboBox.Create(Self);958 FDayCombo := TORDayCombo.Create(Self); 891 959 FDayCombo.Parent := Self; 892 960 FDayCombo.Top := 0; 893 961 FDayCombo.Style := orcsDropDown; 962 FDayCombo.ListItemsOnly := True; 894 963 FDayCombo.OnChange := DayChanged; 895 964 FDayCombo.DropDownCount := 11; … … 914 983 if(not assigned(FYearEdit)) then 915 984 begin 916 FYearEdit := TORDateComboEdit.Create(Self);985 FYearEdit := FORYearEditClass.Create(Self); 917 986 FYearEdit.Parent := Self; 918 987 FYearEdit.Top := 0; … … 922 991 end; 923 992 FYearEdit.Font := Font; 924 TORDateComboEdit(FYearEdit).TemplateField := FTemplateField;993 FYearEdit.TemplateField := FTemplateField; 925 994 Wide := GetYearSize; 926 995 FYearEdit.Width := Wide; … … 947 1016 if(not assigned(FCalBtn)) then 948 1017 begin 949 FCalBtn := TSpeedButton.Create(Self); 1018 FCalBtn := TORDateButton.Create(Self); 1019 FCalBtn.TabStop := FALSE; 950 1020 FCalBtn.Parent := Self; 951 1021 FCalBtn.Top := 0; 952 FCalBtn.Glyph.LoadFromResourceName(hInstance, 'BMP_ELLIPSIS');1022 LoadEllipsis(FCalBtn.Glyph, FBlackColorMode); 953 1023 FCalBtn.OnClick := BtnClicked; 954 1024 end; … … 973 1043 FRebuilding := FALSE; 974 1044 end; 1045 end; 1046 end; 1047 1048 procedure TORDateCombo.SetBlackColorMode(Value: boolean); 1049 begin 1050 if FBlackColorMode <> Value then 1051 begin 1052 FBlackColorMode := Value; 1053 if assigned(FCalBtn) then 1054 LoadEllipsis(FCalBtn.Glyph, FBlackColorMode); 975 1055 end; 976 1056 end; -
cprs/trunk/CPRS-Lib/ORDtTmRng.dfm
r456 r829 18 18 Left = 8 19 19 Top = 44 20 Width = 5 320 Width = 52 21 21 Height = 13 22 22 Caption = 'Begin Date' … … 25 25 Left = 145 26 26 Top = 44 27 Width = 4 527 Width = 44 28 28 Height = 13 29 29 Caption = 'End Date' -
cprs/trunk/CPRS-Lib/ORDtTmRng.pas
r456 r829 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORFn, OR DtTm;7 StdCtrls, ORFn, OR2006Compatibility, ORDtTm; 8 8 9 9 type 10 TORfrmDateRange = class(T Form)10 TORfrmDateRange = class(Tfrm2006Compatibility) 11 11 lblStart: TLabel; 12 12 lblStop: TLabel; … … 21 21 FCalStart: TORDateBox; 22 22 FCalStop: TORDateBox; 23 protected 24 procedure Loaded; override; 23 25 end; 24 26 … … 217 219 FCalStop.TabOrder := 1; 218 220 ResizeAnchoredFormToFont(self); 221 UpdateColorsFor508Compliance(self); 219 222 end; 220 223 … … 225 228 end; 226 229 230 procedure TORfrmDateRange.Loaded; 231 begin 232 inherited Loaded; 233 UpdateColorsFor508Compliance(Self); 234 end; 235 227 236 end. -
cprs/trunk/CPRS-Lib/ORFn.pas
r456 r829 6 6 7 7 uses SysUtils, Windows, Messages, Classes, Controls, StdCtrls, ExtCtrls, ComCtrls, Forms, 8 Graphics, Menus, RichEdit ;8 Graphics, Menus, RichEdit, Buttons; 9 9 10 10 const … … 13 13 BOOLCHAR: array[Boolean] of Char = ('0', '1'); 14 14 UM_STATUSTEXT = (WM_USER + 302); // used to send update status msg to main form 15 COLOR_CREAM = $F0FBFF; 15 16 var 17 ScrollBarHeight: integer = 0; 16 18 17 19 type … … 66 68 function DelimCount(const Str, Delim: string): integer; 67 69 procedure QuickCopy(AFrom, ATo: TObject); 70 procedure QuickAdd(AFrom, ATo: TObject); 71 procedure FastAssign(source, destination: TStrings); 72 procedure FastAddStrings(source, destination: TStrings); 68 73 function ValidFileName(const InitialFileName: string): string; 69 74 … … 84 89 procedure ResizeFormToFont(AForm: TForm); 85 90 procedure ResizeAnchoredFormToFont( AForm: TForm); 91 procedure AdjustForWindowsXPStyleTitleBar(AForm: TForm); 86 92 function ResizeWidth( OldFont: TFont; NewFont: TFont; OldWidth: integer): integer; 87 93 function ResizeHeight( OldFont: TFont; NewFont: TFont; OldHeight: integer): integer; … … 96 102 function PopupComponent(Sender: TObject; PopupMenu: TPopupMenu): TComponent; 97 103 procedure ReformatMemoParagraph(AMemo: TCustomMemo); 98 function ReadOnlyColor: TColor; 104 105 function BlackColorScheme: Boolean; 106 function NormalColorScheme: Boolean; 107 function Get508CompliantColor(Color: TColor): TColor; 108 procedure UpdateColorsFor508Compliance(control: TControl; InputEditControl: boolean = FALSE); 109 procedure UpdateReadOnlyColorScheme(Control: TControl; ReadOnly: boolean); 99 110 100 111 { ListBox Grid functions } … … 116 127 function TabIsPressed : Boolean; 117 128 function ShiftTabIsPressed : Boolean; 129 function EnterIsPressed : Boolean; 118 130 119 131 implementation // --------------------------------------------------------------------------- 120 132 121 133 uses 122 ORCtrls, Grids, Chart, CheckLst ;134 ORCtrls, Grids, Chart, CheckLst, VAUtils; 123 135 124 136 const … … 606 618 function Piece(const S: string; Delim: char; PieceNum: Integer): string; 607 619 { returns the Nth piece (PieceNum) of a string delimited by Delim } 608 var 609 i: Integer; 610 Strt, Next: PChar; 611 begin 612 i := 1; 613 Strt := PChar(S); 614 Next := StrScan(Strt, Delim); 615 while (i < PieceNum) and (Next <> nil) do 616 begin 617 Inc(i); 618 Strt := Next + 1; 619 Next := StrScan(Strt, Delim); 620 end; 621 if Next = nil then Next := StrEnd(Strt); 622 if i < PieceNum then Result := '' else SetString(Result, Strt, Next - Strt); 620 begin 621 Result := VAUtils.Piece(S, Delim, PieceNum); 623 622 end; 624 623 625 624 function Pieces(const S: string; Delim: char; FirstNum, LastNum: Integer): string; 626 { returns several contiguous pieces } 627 var 628 PieceNum: Integer; 629 begin 630 Result := ''; 631 for PieceNum := FirstNum to LastNum do Result := Result + Piece(S, Delim, PieceNum) + Delim; 632 if Length(Result) > 0 then Delete(Result, Length(Result), 1); 625 begin 626 Result := VAUtils.Pieces(S, Delim, FirstNum, LastNum); 633 627 end; 634 628 … … 779 773 if obj is TListBox then 780 774 str[idx] := TListBox(obj).Items 775 else 776 if obj is TORComboBox then 777 str[idx] := TORComboBox(obj).Items 778 else 779 if obj is TComboBox then 780 str[idx] := TComboBox(obj).Items 781 781 else 782 782 if obj is TRichEdit then … … 815 815 if fix[0] then TRichEdit(AFrom).PlainText := FALSE; 816 816 if fix[1] then TRichEdit(ATo).PlainText := FALSE; 817 if ATo is TRichEdit then 818 TRichEdit(ATo).SelStart := Length(TRichEdit(ATo).Lines.Text); //CQ: 16461 819 end; 820 821 type 822 QuickAddError = class(Exception); 823 824 procedure QuickAdd(AFrom, ATo: TObject); 825 var 826 ms: TMemoryStream; 827 idx: integer; 828 str: array[0..1] of TStrings; 829 fix: array[0..1] of boolean; 830 831 procedure GetStrings(obj: TObject); 832 begin 833 if (CompareText(obj.ClassName, 'TRichEditStrings') = 0) then 834 raise QuickCopyError.Create('You must pass the TRichEdit object into QuickAdd, NOT it''s Lines property.'); 835 if obj is TStrings then 836 str[idx] := TStrings(obj) 837 else 838 if obj is TMemo then 839 str[idx] := TMemo(obj).Lines 840 else 841 if obj is TORListBox then 842 str[idx] := TORListBox(obj).Items 843 else 844 if obj is TListBox then 845 str[idx] := TListBox(obj).Items 846 else 847 if obj is TORComboBox then 848 str[idx] := TORComboBox(obj).Items 849 else 850 if obj is TComboBox then 851 str[idx] := TComboBox(obj).Items 852 else 853 if obj is TRichEdit then 854 begin 855 with TRichEdit(obj) do 856 begin 857 str[idx] := Lines; 858 if not PlainText then 859 begin 860 fix[idx] := TRUE; 861 PlainText := TRUE; 862 end; 863 end; 864 end 865 else 866 raise QuickAddError.Create('Unsupported object type (' + obj.ClassName + 867 ') passed into QuickAdd.'); 868 inc(idx); 869 end; 870 871 872 begin 873 fix[0] := FALSE; 874 fix[1] := FALSE; 875 idx := 0; 876 GetStrings(AFrom); 877 GetStrings(ATo); 878 ms := TMemoryStream.Create; 879 try 880 str[1].SaveToStream(ms); 881 ms.Seek(0, soFromEnd); 882 str[0].SaveToStream(ms); 883 ms.Seek(0, soFromBeginning); 884 str[1].Clear; 885 str[1].LoadFromStream(ms); 886 finally 887 ms.Free; 888 end; 889 if fix[0] then TRichEdit(AFrom).PlainText := FALSE; 890 if fix[1] then TRichEdit(ATo).PlainText := FALSE; 891 end; 892 893 procedure FastAssign(source, destination: TStrings); 894 // do not use this with RichEdit Lines unless source is RichEdit with PlainText 895 var 896 ms: TMemoryStream; 897 begin 898 destination.Clear; 899 if (source is TStringList) and (destination is TStringList) then 900 destination.Assign(source) 901 else 902 if (CompareText(source.ClassName, 'TRichEditStrings') = 0) then 903 destination.Assign(source) 904 else 905 begin 906 ms := TMemoryStream.Create; 907 try 908 source.SaveToStream(ms); 909 ms.Seek(0, soFromBeginning); 910 destination.LoadFromStream(ms); 911 finally 912 ms.Free; 913 end; 914 end; 915 end; 916 917 procedure FastAddStrings(source, destination: TStrings); 918 // do not use this with RichEdit Lines unless source and destination are RichEdit with PlainText 919 var 920 ms: TMemoryStream; 921 begin 922 if (source is TStringList) and (destination is TStringList) then 923 destination.AddStrings(source) 924 else 925 begin 926 ms := TMemoryStream.Create; 927 try 928 destination.SaveToStream(ms); 929 ms.Seek(0, soFromEnd); 930 source.SaveToStream(ms); 931 ms.Seek(0, soFromBeginning); 932 destination.Clear; 933 destination.LoadFromStream(ms); 934 finally 935 ms.Free; 936 end; 937 end; 817 938 end; 818 939 … … 861 982 end; {for i} 862 983 AList.Clear; 863 AList.Assign(NewList);984 FastAssign(NewList, AList); 864 985 finally 865 986 NewList.Free; … … 1248 1369 end; 1249 1370 1371 var 1372 AlignList, AnchorList: TStringList; 1373 1374 function AnchorsToStr(Control: TControl): string; 1375 var 1376 j: TAnchorKind; 1377 1378 begin 1379 Result := ''; 1380 for j := low(TAnchorKind) to high(TAnchorKind) do 1381 if j in Control.Anchors then 1382 Result := result + '1' 1383 else 1384 Result := result + '0' 1385 end; 1386 1387 function StrToAnchors(i: integer): TAnchors; 1388 var 1389 j: TAnchorKind; 1390 value: string; 1391 idx : integer; 1392 begin 1393 Result := []; 1394 value := AnchorList[i]; 1395 idx := 1; 1396 for j := low(TAnchorKind) to high(TAnchorKind) do 1397 begin 1398 if copy(value,idx,1) = '1' then 1399 include(Result, j); 1400 inc(idx); 1401 end; 1402 end; 1403 1404 procedure SuspendAlign(AForm: TForm); 1405 var 1406 i: integer; 1407 control: TControl; 1408 begin 1409 AForm.DisableAlign; 1410 AlignList.Clear; 1411 AnchorList.Clear; 1412 for i := 0 to AForm.ControlCount-1 do 1413 begin 1414 control := AForm.Controls[i]; 1415 AlignList.Add(IntToStr(ord(control.align))); 1416 control.Align := alNone; 1417 AnchorList.Add(AnchorsToStr(control)); 1418 control.Anchors := []; 1419 end; 1420 end; 1421 1422 procedure RestoreAlign(AForm: TForm); 1423 var 1424 i: integer; 1425 control: TControl; 1426 begin 1427 try 1428 for i := 0 to AForm.ControlCount-1 do 1429 begin 1430 control := AForm.Controls[i]; 1431 control.Align := TAlign(StrToIntDef(AlignList[i],0)); 1432 control.Anchors := StrToAnchors(i); 1433 end; 1434 AlignList.Clear; 1435 AnchorList.Clear; 1436 finally 1437 AForm.EnableAlign; 1438 end; 1439 end; 1440 1250 1441 procedure ResizeFormToFont(AForm: TForm); 1251 1442 var 1252 1443 Rect: TRect; 1253 begin 1444 OldResize: TNotifyEvent; 1445 begin 1446 // CQ# 11481 apply size changes to form all at once, instead of piece by piece. Otherwise, 1447 // multiple calls to fAutoSz.FormResize, even if the form has not resized, can distort 1448 // the controls beyond the size of the form. 1254 1449 with AForm do begin 1255 ClientWidth := ResizeWidth( Font, MainFont, ClientWidth); 1256 ClientHeight := ResizeHeight( Font, MainFont, ClientHeight); 1257 HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range); 1258 VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range); 1259 Rect := BoundsRect; 1260 ForceInsideWorkArea(Rect); 1261 BoundsRect := Rect; 1262 ResizeFontsInDescendants( Font, MainFont, AForm); 1263 //Important: We are using the font to calculate everything, so don't 1264 //change font until now. 1265 Font.Size := MainFont.Size; 1450 OldResize := AForm.OnResize; 1451 AForm.OnResize := nil; 1452 try 1453 SuspendAlign(AForm); 1454 try 1455 HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range); 1456 VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range); 1457 ClientWidth := ResizeWidth( Font, MainFont, ClientWidth); 1458 ClientHeight := ResizeHeight( Font, MainFont, ClientHeight); 1459 Rect := BoundsRect; 1460 ForceInsideWorkArea(Rect); 1461 BoundsRect := Rect; 1462 finally 1463 RestoreAlign(AForm); 1464 end; 1465 ResizeFontsInDescendants( Font, MainFont, AForm); 1466 //Important: We are using the font to calculate everything, so don't 1467 //change font until now. 1468 Font.Size := MainFont.Size; 1469 finally 1470 if(Assigned(OldResize)) then 1471 begin 1472 AForm.OnResize := OldResize; 1473 OldResize(AForm); 1474 end; 1475 end; 1266 1476 end; 1267 1477 end; … … 1270 1480 var 1271 1481 Rect: TRect; 1482 OldResize: TNotifyEvent; 1483 1272 1484 begin 1273 1485 with AForm do begin 1274 ClientWidth := ResizeWidth( Font, MainFont, ClientWidth); 1275 ClientHeight := ResizeHeight( Font, MainFont, ClientHeight); 1276 HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range); 1277 VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range); 1278 Rect := BoundsRect; 1279 ForceInsideWorkArea(Rect); 1280 BoundsRect := Rect; 1281 ResizeDescendants( Font, MainFont, AForm); 1282 ResizeFontsInDescendants( Font, MainFont, AForm); 1283 //Important: We are using the font to calculate everything, so don't 1284 //change font until now. 1285 Font.Size := MainFont.Size; 1486 // CQ# 11481 - see ResizeFormToFont 1487 OldResize := AForm.OnResize; 1488 AForm.OnResize := nil; 1489 try 1490 HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range); 1491 VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range); 1492 ClientWidth := ResizeWidth( Font, MainFont, ClientWidth); 1493 ClientHeight := ResizeHeight( Font, MainFont, ClientHeight); 1494 Rect := BoundsRect; 1495 ForceInsideWorkArea(Rect); 1496 BoundsRect := Rect; 1497 ResizeDescendants( Font, MainFont, AForm); 1498 ResizeFontsInDescendants( Font, MainFont, AForm); 1499 //Important: We are using the font to calculate everything, so don't 1500 //change font until now. 1501 Font.Size := MainFont.Size; 1502 finally 1503 if(Assigned(OldResize)) then 1504 begin 1505 AForm.OnResize := OldResize; 1506 OldResize(AForm); 1507 end; 1508 end; 1509 end; 1510 end; 1511 1512 // CQ 11485 - Adjusts all forms - adds additional height to the form to 1513 // adjust for Windows XP style title bars, and for large fonts in title bar 1514 procedure AdjustForWindowsXPStyleTitleBar(AForm: TForm); 1515 const 1516 DEFAULT_CAPTION_HEIGHT = 19; 1517 DEFAULT_MENU_HEIGHT = 19; 1518 1519 var 1520 dxsb, dysb, dy, menuDY: integer; 1521 1522 begin 1523 // Call GetSystemMetrics each time because values can change between calls 1524 dy := GetSystemMetrics(SM_CYCAPTION) - DEFAULT_CAPTION_HEIGHT; 1525 if (AForm.Menu <> nil) then 1526 begin 1527 menuDY := GetSystemMetrics(SM_CYMENU) - DEFAULT_MENU_HEIGHT; 1528 inc(dy, menuDY); 1529 end; 1530 if dy <> 0 then 1531 begin 1532 SuspendAlign(AForm); 1533 try 1534 // Assitional adjustment to allow scroll bars to dissappear 1535 dxsb := GetSystemMetrics(SM_CXVSCROLL); 1536 dysb := GetSystemMetrics(SM_CYHSCROLL); 1537 AForm.Height := AForm.Height + dy + dysb; 1538 AForm.Width := AForm.Width + dxsb; 1539 AForm.Height := AForm.Height - dysb; 1540 AForm.Width := AForm.Width - dxsb; 1541 finally 1542 RestoreAlign(AForm); 1543 end; 1286 1544 end; 1287 1545 end; … … 1329 1587 begin 1330 1588 DC := GetDC(0); 1331 SaveFont := SelectObject(DC, AFontHandle); 1332 GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize); 1333 Result := TextSize.cx; 1334 SelectObject(DC, SaveFont); 1335 ReleaseDC(0, DC); 1589 try 1590 SaveFont := SelectObject(DC, AFontHandle); 1591 try 1592 GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize); 1593 Result := TextSize.cx; 1594 finally 1595 SelectObject(DC, SaveFont); 1596 end; 1597 finally 1598 ReleaseDC(0, DC); 1599 end; 1336 1600 end; 1337 1601 … … 1344 1608 begin 1345 1609 DC := GetDC(0); 1346 SaveFont := SelectObject(DC, AFontHandle); 1347 GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize); 1348 Result := TextSize.cy; 1349 SelectObject(DC, SaveFont); 1350 ReleaseDC(0, DC); 1610 try 1611 SaveFont := SelectObject(DC, AFontHandle); 1612 try 1613 GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize); 1614 Result := TextSize.cy; 1615 finally 1616 SelectObject(DC, SaveFont); 1617 end; 1618 finally 1619 ReleaseDC(0, DC); 1620 end; 1621 if Result > 255 then // CQ 11493 1622 Result := 255; // This is maximum allowed by a Windows 1351 1623 end; 1352 1624 … … 1393 1665 end; 1394 1666 end; 1667 if Result > 255 then // CQ 11492 1668 Result := 255; // This is maximum allowed by a Windows 1395 1669 end; 1396 1670 … … 1471 1745 1472 1746 var 1473 uReadOnlyColor: TColor; 1474 uHaveReadOnlyColor: boolean = FALSE; 1475 1476 function ReadOnlyColor: TColor; 1477 begin 1478 if not uHaveReadOnlyColor then 1479 begin 1480 uHaveReadOnlyColor := TRUE; 1481 if ColorToRGB(clWindow) = ColorToRGB(clWhite) then 1482 uReadOnlyColor := $00F0FBFF 1747 uNormalColorScheme: boolean = false; 1748 uBlackColorScheme: boolean = false; 1749 uWhiteColorScheme: boolean = false; 1750 uMaroonColorWhenBlack: TColor = clMaroon; 1751 uCheckColorScheme: boolean = true; 1752 PURE_BLACK: longint = 0; 1753 1754 const 1755 uBorderlessWindowColorWhenBlack: TColor = clNavy; 1756 1757 1758 procedure CheckColorScheme; 1759 begin 1760 if uCheckColorScheme then 1761 begin 1762 uNormalColorScheme := 1763 ((ColorToRGB(clWindow) = ColorToRGB(clWhite)) and 1764 (ColorToRGB(clWindowText) = ColorToRGB(clBlack)) and 1765 (ColorToRGB(clInfoText) = ColorToRGB(clBlack)) and 1766 (ColorToRGB(clInfoBk) <> ColorToRGB(clWhite))); 1767 1768 uBlackColorScheme := ((ColorToRGB(clBtnFace) = ColorToRGB(clBlack)) and 1769 (ColorToRGB(clWindow) = ColorToRGB(clBlack))); 1770 uWhiteColorScheme := ((ColorToRGB(clBtnFace) = ColorToRGB(clWhite)) and 1771 (ColorToRGB(clWindow) = ColorToRGB(clWhite))); 1772 1773 if uBlackColorScheme then 1774 begin 1775 if(ColorToRGB(clGrayText) = ColorToRGB(clWindowText)) then 1776 uMaroonColorWhenBlack := clHighlightText 1777 else 1778 uMaroonColorWhenBlack := clGrayText; 1779 end; 1780 1781 uCheckColorScheme := FALSE; 1782 end; 1783 end; 1784 1785 function BlackColorScheme: Boolean; 1786 begin 1787 if uCheckColorScheme then CheckColorScheme; 1788 Result := uBlackColorScheme; 1789 end; 1790 1791 function NormalColorScheme: Boolean; 1792 begin 1793 if uCheckColorScheme then CheckColorScheme; 1794 Result := uNormalColorScheme; 1795 end; 1796 1797 function Get508CompliantColor(Color: TColor): TColor; 1798 begin 1799 Result := Color; 1800 if NormalColorScheme then exit; 1801 1802 case Color of 1803 clCream: Result := clInfoBk; 1804 clBlack: Result := clWindowText; 1805 clWhite: Result := clWindow; 1806 end; 1807 1808 if uBlackColorScheme then 1809 begin 1810 case Color of 1811 clBlue: Result := clAqua; 1812 clMaroon: Result := uMaroonColorWhenBlack; 1813 // clRed: Result := clFuchsia; 1814 end; 1815 end; 1816 1817 if uWhiteColorScheme then 1818 begin 1819 case Color of 1820 clGrayText: Result := clGray; 1821 end; 1822 end; 1823 end; 1824 1825 type 1826 TExposedControl = class(TControl) 1827 public 1828 property Color; 1829 property Font; 1830 end; 1831 1832 TExposedCustomEdit = class(TCustomEdit) 1833 public 1834 property BorderStyle; 1835 property ReadOnly; 1836 end; 1837 1838 procedure UpdateColorsFor508Compliance(control: TControl; InputEditControl: boolean = FALSE); 1839 var 1840 BitMapLevelCheck: integer; 1841 Level: integer; 1842 1843 1844 procedure BlackColorSchemeUpdate(control: TControl); 1845 var 1846 bitmap: TBitMap; 1847 edit: TExposedCustomEdit; 1848 x,y: integer; 1849 cbmCtrl: IORBlackColorModeCompatible; 1850 1851 begin 1852 if uBlackColorScheme then 1853 begin 1854 if Level < BitMapLevelCheck then 1855 begin 1856 if control.GetInterface(IORBlackColorModeCompatible, cbmCtrl) then 1857 begin 1858 cbmCtrl.SetBlackColorMode(TRUE); 1859 BitMapLevelCheck := Level; 1860 cbmCtrl := nil; 1861 end 1862 else 1863 begin 1864 if (control is TBitBtn) then 1865 begin 1866 bitmap := TBitBtn(control).Glyph; 1867 for x := 0 to bitmap.Width-1 do 1868 begin 1869 for y := 0 to bitmap.Height-1 do 1870 begin 1871 if ColorToRGB(bitmap.Canvas.Pixels[x,y]) = PURE_BLACK then 1872 bitmap.Canvas.Pixels[x,y] := clWindowText; 1873 end; 1874 end; 1875 end; 1876 end; 1877 end; 1878 1879 if (control is TCustomEdit) and InputEditControl then 1880 begin 1881 edit := TExposedCustomEdit(control); 1882 if (edit.BorderStyle = bsNone) then 1883 edit.Color := uBorderlessWindowColorWhenBlack; 1884 end; 1885 1886 end; 1887 end; 1888 1889 procedure ComponentUpdateColorsFor508Compliance(control: TControl); 1890 var 1891 OldComponentColor, OldFontColor, NewComponentColor, NewFontColor: TColor; 1892 begin 1893 OldComponentColor := TExposedControl(control).Color; 1894 OldFontColor := TExposedControl(control).Font.Color; 1895 NewComponentColor := Get508CompliantColor(OldComponentColor); 1896 if NewComponentColor = clInfoBk then 1897 begin 1898 if (OldFontColor = clInfoBk) or (OldFontColor = clCream) then 1899 NewFontColor := clInfoBk // used for hiding text 1900 else 1901 NewFontColor := clInfoText; 1902 end 1483 1903 else 1484 uReadOnlyColor := clWindow; 1485 end; 1486 Result := uReadOnlyColor; 1904 NewFontColor := Get508CompliantColor(OldFontColor); 1905 if NewComponentColor <> OldComponentColor then 1906 TExposedControl(control).Color := NewComponentColor; 1907 if NewFontColor <> OldFontColor then 1908 TExposedControl(control).Font.Color := NewFontColor; 1909 BlackColorSchemeUpdate(control); 1910 end; 1911 1912 procedure ScanAllComponents(control: TControl); 1913 var 1914 i: integer; 1915 1916 begin 1917 ComponentUpdateColorsFor508Compliance(Control); 1918 if control is TWinControl then 1919 begin 1920 inc(Level); 1921 try 1922 for i := 0 to TWinControl(Control).ControlCount-1 do 1923 begin 1924 ScanAllComponents(TWinControl(Control).Controls[i]); 1925 end; 1926 finally 1927 dec(Level); 1928 if BitMapLevelCheck = Level then 1929 BitMapLevelCheck := MaxInt; 1930 end; 1931 end; 1932 end; 1933 1934 begin 1935 if NormalColorScheme then exit; 1936 BitMapLevelCheck := MaxInt; 1937 Level := 0; 1938 ScanAllComponents(control); 1939 end; 1940 1941 procedure UpdateReadOnlyColorScheme(Control: TControl; ReadOnly: boolean); 1942 begin 1943 with TExposedControl(Control) do 1944 begin 1945 if ReadOnly then 1946 begin 1947 Color := Get508CompliantColor(clCream); 1948 Font.Color := clInfoText; 1949 end 1950 else 1951 begin 1952 Color := clWindow; 1953 Font.Color := clWindowText; 1954 end; 1955 end; 1487 1956 end; 1488 1957 … … 1521 1990 end; 1522 1991 Canvas.FillRect(ARect); 1523 Canvas.Pen.Color := clSilver;1992 Canvas.Pen.Color := Get508CompliantColor(clSilver); 1524 1993 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); 1525 1994 Canvas.LineTo(ARect.Right, ARect.Bottom - 1); … … 1714 2183 begin 1715 2184 Result := Boolean(Hi(GetKeyState(VK_TAB))) and not Boolean(Hi(GetKeyState(VK_SHIFT))); 2185 Result := Result and not Boolean(Hi(GetKeyState(VK_CONTROL))); 1716 2186 end; 1717 2187 … … 1719 2189 begin 1720 2190 Result := Boolean(Hi(GetKeyState(VK_TAB))) and Boolean(Hi(GetKeyState(VK_SHIFT))); 1721 end; 1722 2191 Result := Result and not Boolean(Hi(GetKeyState(VK_CONTROL))); 2192 end; 2193 2194 function EnterIsPressed : Boolean; 2195 begin 2196 Result := Boolean(Hi(GetKeyState(VK_RETURN))); 2197 end; 1723 2198 1724 2199 initialization … … 1726 2201 FBaseFont.Name := BaseFontName; 1727 2202 FBaseFont.Size := BaseFontSize; 2203 ScrollBarHeight := GetSystemMetrics(SM_CYHSCROLL); 2204 AlignList := TStringList.Create; 2205 AnchorList := TStringList.Create; 2206 PURE_BLACK := ColorToRGB(clBlack); 1728 2207 1729 2208 finalization 1730 2209 FBaseFont.Free; 1731 2210 KillObj(@IdleCaller); 2211 FreeAndNil(AlignList); 2212 FreeAndNil(AnchorList); 1732 2213 1733 2214 end. -
cprs/trunk/CPRS-Lib/ORNet.pas
r456 r829 43 43 {$ENDIF} 44 44 RPCLastCall: string; 45 46 AppStartedCursorForm: TForm = nil; 45 47 46 48 implementation … … 263 265 AStringList.Add(' '); 264 266 AStringList.Add('Results -----------------------------------------------------------------'); 265 AStringList.AddStrings(RPCBrokerV.Results);267 FastAddStrings(RPCBrokerV.Results, AStringList); 266 268 uCallList.Add(AStringList); 267 269 if uShowRPCs then StatusText(''); … … 347 349 end; 348 350 351 function GetRPCCursor: TCursor; 352 var 353 pt: TPoint; 354 begin 355 Result := crHourGlass; 356 if assigned(AppStartedCursorForm) and (AppStartedCursorForm.Visible) then 357 begin 358 pt := Mouse.CursorPos; 359 if PtInRect(AppStartedCursorForm.BoundsRect, pt) then 360 Result := crAppStart; 361 end; 362 end; 363 349 364 procedure CallV(const RPCName: string; const AParam: array of const); 350 365 { calls the broker leaving results in results property which must be read by caller } … … 353 368 begin 354 369 SavedCursor := Screen.Cursor; 355 Screen.Cursor := crHourGlass;370 Screen.Cursor := GetRPCCursor; 356 371 SetParams(RPCName, AParam); 357 372 CallBroker; //RPCBrokerV.Call; … … 365 380 begin 366 381 SavedCursor := Screen.Cursor; 367 Screen.Cursor := crHourGlass;382 Screen.Cursor := GetRPCCursor; 368 383 SetParams(RPCName, AParam); 369 384 CallBroker; //RPCBrokerV.Call; … … 379 394 if ReturnData = nil then raise Exception.Create('TString not created'); 380 395 SavedCursor := Screen.Cursor; 381 Screen.Cursor := crHourGlass;396 Screen.Cursor := GetRPCCursor; 382 397 SetParams(RPCName, AParam); 383 398 CallBroker; //RPCBrokerV.Call; 384 ReturnData.Assign(RPCBrokerV.Results);399 FastAssign(RPCBrokerV.Results, ReturnData); 385 400 Screen.Cursor := SavedCursor; 386 401 end; … … 395 410 begin 396 411 SavedCursor := Screen.Cursor; 397 Screen.Cursor := crHourGlass;412 Screen.Cursor := GetRPCCursor; 398 413 SetParams(RPCName, AParam); 399 414 RPCBrokerV.Call; … … 450 465 procedure LoadRPCData(Dest: TStrings; ID: Integer); 451 466 begin 452 if (ID > -1) and (ID < uCallList.Count) then Dest.Assign(TStringList(uCallList.Items[ID]));467 if (ID > -1) and (ID < uCallList.Count) then FastAssign(TStringList(uCallList.Items[ID]), Dest); 453 468 end; 454 469 -
cprs/trunk/CPRS-Lib/ORSystem.pas
r456 r829 2 2 3 3 {$O-} 4 {$WARN SYMBOL_PLATFORM OFF} 4 5 5 6 interface … … 19 20 CPRS_LAST_DATE = 'Software\Vista\CPRS\DateUpdated'; 20 21 21 { values that can be passed to FileVersionValue }22 FILE_VER_COMPANYNAME = '\StringFileInfo\040904E4\CompanyName';23 FILE_VER_FILEDESCRIPTION = '\StringFileInfo\040904E4\FileDescription';24 FILE_VER_FILEVERSION = '\StringFileInfo\040904E4\FileVersion';25 FILE_VER_INTERNALNAME = '\StringFileInfo\040904E4\InternalName';26 FILE_VER_LEGALCOPYRIGHT = '\StringFileInfo\040904E4\LegalCopyright';27 FILE_VER_ORIGINALFILENAME = '\StringFileInfo\040904E4\OriginalFilename';28 FILE_VER_PRODUCTNAME = '\StringFileInfo\040904E4\ProductName';29 FILE_VER_PRODUCTVERSION = '\StringFileInfo\040904E4\ProductVersion';30 FILE_VER_COMMENTS = '\StringFileInfo\040904E4\Comments';31 32 33 22 function AppOutOfDate(AppName: string): Boolean; 34 23 function ClientVersion(const AFileName: string): string; … … 40 29 //procedure FileCopy(const FromFileName, ToFileName: string); 41 30 //procedure FileCopyWithDate(const FromFileName, ToFileName: string); 42 function FileVersionValue(const AFileName, AValueName: string): string;43 31 function FullToFilePart(const AFileName: string): string; 44 32 function FullToPathPart(const AFileName: string): string; … … 60 48 procedure RunProgram(const AppName: string); 61 49 function UpdateSelf: Boolean; 50 function BorlandDLLVersionOK: boolean; 62 51 63 52 implementation … … 110 99 // check for different file date in the gold directory 111 100 GoldName := RegReadStr(CPRS_REG_GOLD); 112 if Length(GoldName) = 0 then Exit; 101 if (Length(GoldName) = 0) then exit; 102 if not DirectoryExists(GoldName) then 103 begin 104 if Pos('"', Goldname) > 0 then 105 begin 106 Goldname := Copy(GoldName, 2, MaxInt); 107 if Pos('"', Goldname) > 0 then 108 Goldname := Copy(GoldName, 1, Length(GoldName) - 1); 109 end; 110 end; 111 if (not DirectoryExists(GoldName)) then Exit; 113 112 GoldName := GoldName + FullToFilePart(AppName); 114 113 if FileExists(GoldName) then … … 139 138 IntToStr(HIWORD(dwFileVersionLS)) + '.' + 140 139 IntToStr(LOWORD(dwFileVersionLS)); 141 end;142 end;143 144 function FileVersionValue(const AFileName, AValueName: string): string;145 type146 PValBuf = ^TValBuf;147 TValBuf = array[0..255] of Char;148 var149 VerSize, ValSize, AHandle: DWORD;150 VerBuf: Pointer;151 ValBuf: PValBuf;152 begin153 Result := '';154 VerSize:=GetFileVersionInfoSize(PChar(AFileName), AHandle);155 if VerSize > 0 then156 begin157 GetMem(VerBuf, VerSize);158 try159 GetFileVersionInfo(PChar(AFileName), AHandle, VerSize, VerBuf);160 VerQueryValue(VerBuf, PChar(AValueName), Pointer(ValBuf), ValSize);161 SetString(Result, ValBuf^, ValSize);162 finally163 FreeMem(VerBuf);164 end;165 140 end; 166 141 end; … … 551 526 *) 552 527 528 function BorlandDLLVersionOK: boolean; 529 const 530 DLL_CURRENT_VERSION = 10; 531 TC_DLL_ERR = 'ERROR - BORLNDMM.DLL'; 532 TX_NO_RUN = 'This version of CPRS is unable to run because' + CRLF; 533 TX_NO_DLL = 'no copy of BORLNDMM.DLL can be found' + CRLF + 534 'in your workstation''s current PATH.'; 535 TX_OLD_DLL1 = 'the copy of BORLNDMM.DLL located at:' + CRLF + CRLF; 536 TX_OLD_DLL2 = CRLF + CRLF + 'is out of date (Version '; 537 TX_CALL_IRM = CRLF + CRLF +'Please contact IRM for assistance.'; 538 var 539 DLLHandle: HMODULE; 540 DLLNamePath: array[0..261] of Char; 541 DLLVersion: string; 542 begin 543 Result := TRUE; 544 DLLHandle := GetModuleHandle('BORLNDMM.DLL'); 545 if DLLHandle <=0 then 546 begin 547 InfoBox(TX_NO_RUN + TX_NO_DLL + TX_CALL_IRM, TC_DLL_ERR, MB_ICONERROR or MB_OK); 548 Result := FALSE; 549 Exit; 550 end; 551 Windows.GetModuleFileName(DLLHandle, DLLNamePath, 261); 552 DLLVersion := ClientVersion(DLLNamePath); 553 if StrToIntDef(Piece(DLLVersion, '.', 1), 0) < DLL_CURRENT_VERSION then 554 begin 555 InfoBox(TX_NO_RUN + TX_OLD_DLL1 + ' ' + DLLNamePath + TX_OLD_DLL2 + DLLVersion + ')' + 556 TX_CALL_IRM, TC_DLL_ERR, MB_ICONERROR or MB_OK); 557 Result := false; 558 end; 559 end; 560 553 561 end.
Note:
See TracChangeset
for help on using the changeset viewer.