Changeset 1679 for cprs/trunk/CPRS-Chart/fMHTest.pas
- Timestamp:
- May 7, 2015, 12:34:29 PM (9 years ago)
- File:
-
- 1 edited
-
cprs/trunk/CPRS-Chart/fMHTest.pas (modified) (25 diffs)
Legend:
- Unmodified
- Added
- Removed
-
cprs/trunk/CPRS-Chart/fMHTest.pas
r830 r1679 1 1 unit fMHTest; 2 3 {$DEFINE CCOWBROKER} 2 4 3 5 interface … … 6 8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 9 StdCtrls, ExtCtrls, ORCtrls, ORFn, uConst, fBase508Form, uDlgComponents, 8 VA508AccessibilityManager, uCore, orNet, TRPCB, StrUtils, rCore, VAUtils; 10 VA508AccessibilityManager, uCore, orNet, TRPCB, StrUtils, rCore, VAUtils 11 ; 9 12 10 13 type 11 TShowProc = procedure(Broker: TRPCBroker; 14 TShowProc = procedure( 15 RPCBrokerV: TRPCBroker; 12 16 InstrumentName, 13 17 PatientDFN, … … 21 25 var ProgressNote: string); stdcall; 22 26 23 TSaveProc = procedure(Broker: TRPCBroker; 27 TSaveProc = procedure( 28 RPCBrokerV: TRPCBroker; 24 29 InstrumentName, 25 30 PatientDFN, … … 30 35 var Status: string); stdcall; 31 36 32 TRemoveTempFile = procedure( 37 TRemoveTempVistaFile = procedure( 38 RPCBrokerV: TRPCBroker; 33 39 InstrumentName, 34 40 PatientDFN: string); stdcall; … … 85 91 var 86 92 MHDLLHandle: THandle = 0; 87 93 88 94 implementation 89 95 … … 107 113 ShowProc : TShowProc = nil; 108 114 SaveProc : TSaveProc = nil; 109 RemoveTemp File : TRemoveTempFile = nil;110 CloseProc : TCloseProc = nil;115 RemoveTempVistaFile : TRemoveTempVistaFile = nil; 116 CloseProc : TCloseProc = nil; 111 117 SHARE_DIR = '\VISTA\Common Files\'; 112 118 var … … 115 121 FYPos: TList; 116 122 UsedMHDll: TUsedMHDll; 117 //DLLForceClose: boolean = false;118 123 119 124 type … … 147 152 end; 148 153 154 const 155 MHDLLName = 'YS_MHA_A.DLL'; 156 157 procedure LoadMHDLL; 158 var 159 MHPath: string; 160 161 begin 162 if MHDLLHandle = 0 then 163 begin 164 MHPath := GetProgramFilesPath + SHARE_DIR + MHDLLName; 165 MHDLLHandle := LoadLibrary(PChar(MHPath)); 166 end; 167 end; 168 169 procedure UnloadMHDLL; 170 begin 171 if MHDLLHandle <> 0 then 172 begin 173 FreeLibrary(MHDLLHandle); 174 MHDLLHandle := 0; 175 end; 176 end; 177 149 178 procedure ProcessMsg; 150 179 var … … 224 253 function SaveMHTest(TestName, date, Loc: string): boolean; 225 254 var 226 MHPath, save: string; 227 228 begin 229 MHPath := GetProgramFilesPath + SHARE_DIR + 'YS_MHA'; 230 if MHDLLHandle = 0 then 231 MHDLLHandle := LoadLibrary(PChar(MHPath)); 255 save: string; 256 begin 257 LoadMHDLL; 232 258 Result := true; 233 259 if MHDLLHandle = 0 then 234 260 begin 235 InfoBox( 'YS_MHA.DLLnot available', 'Error', MB_OK);261 InfoBox(MHDLLName + ' not available', 'Error', MB_OK); 236 262 Exit; 237 263 end … … 244 270 begin 245 271 // function not found.. misspelled? 246 infoBox('Save Instrument Function not found within YS_MHA.DLL.', 'Error', MB_OK);272 infoBox('Save Instrument Function not found within ' + MHDLLName + '.', 'Error', MB_OK); 247 273 Exit; 248 274 end; … … 250 276 if Assigned(SaveProc) then 251 277 begin 252 // fFrame.frmFrame.DLLActive := True;253 278 try 254 279 SaveProc(RPCBrokerV, … … 258 283 InttoStr(User.duz), //AdministeredByDUZ 259 284 date, 260 Loc , //LocationIEN285 Loc + 'V', //LocationIEN 261 286 save); 262 287 finally 263 // fFrame.frmFrame.DLLActive := false;264 288 if RPCBrokerV.CurrentContext <> 'OR CPRS GUI CHART' then 265 289 begin … … 270 294 end; 271 295 finally 272 if MHDLLHandle <> 0 then 273 begin 274 FreeLibrary(MHDLLHandle); 275 MHDLLHandle := 0; 276 end; 296 UnloadMHDLL; 277 297 end; {try..finally} 278 298 end; … … 280 300 281 301 procedure RemoveMHTest(TestName: string); 282 var 283 MHPath: string; 284 begin 285 MHPath := GetProgramFilesPath + SHARE_DIR + 'YS_MHA'; 302 begin 303 LoadMHDLL; 286 304 if MHDLLHandle = 0 then 287 MHDLLHandle := LoadLibrary(PChar(MHPath)); 288 if MHDLLHandle = 0 then 289 begin 290 InfoBox('YS_MHA.DLL not available', 'Error', MB_OK); 305 begin 306 InfoBox(MHDLLName + ' not available', 'Error', MB_OK); 291 307 Exit; 292 308 end … … 294 310 begin 295 311 try 296 @RemoveTemp File := GetProcAddress(MHDLLHandle, 'RemoveTempFile');297 298 if @RemoveTemp File = nil then312 @RemoveTempVistaFile := GetProcAddress(MHDLLHandle, 'RemoveTempVistaFile'); 313 314 if @RemoveTempVistaFile = nil then 299 315 begin 300 316 // function not found.. misspelled? 301 InfoBox('Remove Temp File function not found within YS_MHA.DLL.', 'Error', MB_OK);317 InfoBox('Remove Temp File function not found within ' + MHDLLName + '.', 'Error', MB_OK); 302 318 Exit; 303 319 end; 304 320 305 if Assigned(RemoveTemp File) then321 if Assigned(RemoveTempVistaFile) then 306 322 begin 307 // fFrame.frmFrame.DLLActive := True;308 323 try 309 RemoveTempFile(UpperCase(TestName), //InstrumentName 324 RemoveTempVistaFile(RPCBrokerV, 325 UpperCase(TestName), //InstrumentName 310 326 Patient.DFN); 311 327 finally 312 // fFrame.frmFrame.DLLActive := False;313 328 if RPCBrokerV.CurrentContext <> 'OR CPRS GUI CHART' then 314 329 begin … … 319 334 end; 320 335 finally 321 if MHDLLHandle <> 0 then 322 begin 323 FreeLibrary(MHDLLHandle); 324 MHDLLHandle := 0; 325 end; 336 UnloadMHDLL; 326 337 end; {try..finally} 327 338 end; … … 329 340 330 341 function CheckforMHDll: boolean; 331 var332 MHPath: string;333 342 begin 334 343 Result := True; … … 346 355 if MHDLLHandle = 0 then // if not 0 the DLL already loaded - result = true 347 356 begin 348 MHPath := GetProgramFilesPath + SHARE_DIR + 'YS_MHA'; 349 MHDLLHandle := LoadLibrary(PChar(MHPath)); 357 LoadMHDLL; 350 358 if MHDLLHandle = 0 then 351 359 Result := false 352 360 else 353 begin 354 FreeLibrary(MHDLLHandle); 355 MHDLLHandle := 0; 356 end; 361 UnloadMHDLL; 357 362 end; 358 363 end; … … 368 373 end; 369 374 finally 370 if MHDLLHandle <> 0 then 371 begin 372 FreeLibrary(MHDLLHandle); 373 MHDLLHandle := 0; 374 end; 375 UnloadMHDLL; 375 376 end; {try..finally} 376 377 end; … … 693 694 function TfrmMHTest.CallMHDLL(TestName: string; Required: boolean): String; 694 695 var 695 // dllHandle : THandle; 696 ProgressNote, MHPath : string; 696 ProgressNote : string; 697 697 begin 698 698 ProgressNote := ''; … … 704 704 if UsedMHDll.Display = false then exit; 705 705 end; 706 MHPath := GetProgramFilesPath + SHARE_DIR + 'YS_MHA'; 707 if MHDLLHandle = 0 then 708 MHDLLHandle := LoadLibrary(PChar(MHPath)); 706 LoadMHDLL; 709 707 Result := ''; 710 708 if MHDLLHandle = 0 then 711 709 begin 712 InfoBox('YS_MHA.dll not available.' + CRLF + 'CPRS will continue processing the MH test using the previous format.' + 713 CRLF + CRLF + 'Contact IRM to install the YS_MHA.dll file on this machine.', 'Warning', MB_OK); 710 InfoBox(MHDLLName + ' not available.' + CRLF + 711 'CPRS will continue processing the MH test using the previous format.' + 712 CRLF + CRLF + 'Contact IRM to install the ' + MHDLLName + 713 ' file on this machine.', 'Warning', MB_OK); 714 714 Exit; 715 715 end … … 722 722 begin 723 723 // function not found.. misspelled? 724 InfoBox('Function ShowInstrument not found within YS_MHA.DLL not available', 'Error', MB_OK); 724 InfoBox('Function ShowInstrument not found within ' + MHDLLName + 725 ' not available', 'Error', MB_OK); 725 726 Exit; 726 727 end; … … 728 729 if Assigned(ShowProc) then 729 730 begin 730 // MHDLLHandle := dllHandle;731 731 Result := ''; 732 // fFrame.frmFrame.DLLActive := True;733 732 try 734 733 ShowProc(RPCBrokerV, … … 740 739 InttoStr(User.duz), //AdministeredByDUZ 741 740 Encounter.LocationName, //Location 742 InttoStr(Encounter.Location) , //LocationIEN741 InttoStr(Encounter.Location) + 'V', //LocationIEN 743 742 Required, 744 743 ProgressNote); 745 744 Result := ProgressNote; 746 745 finally 747 // MHDllHandle := 0; 748 // fFrame.frmFrame.DLLActive := false; 749 if RPCBrokerV.CurrentContext <> 'OR CPRS GUI CHART' then 746 // if RPCBrokerV.CurrentContext <> 'OR CPRS GUI CHART' then 750 747 begin 751 748 if RPCBrokerV.CreateContext('OR CPRS GUI CHART') = false then … … 755 752 end; 756 753 finally 757 if MHDLLHandle <> 0 then 758 begin 759 FreeLibrary(MHDLLHandle); 760 MHDllHandle := 0; 761 end; 754 UnloadMHDLL; 762 755 end; {try..finally} 763 756 //Result := ProgressNote;
Note:
See TracChangeset
for help on using the changeset viewer.
