unit MainU; (* WorldVistA Configuration Utility (c) 8/2008 Kevin Toppenberg Programmed by Kevin Toppenberg, Eddie Hagood Family Physicians of Greeneville, PC 1410 Tusculum Blvd, Suite 2600 Greeneville, TN 37745 kdtop@yahoo.com This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, StrUtils, ORNet, ORFn, ComCtrls, ToolWin, Grids, ORCtrls, ExtCtrls, Buttons, AppEvnts, Menus, ImgList, {$IFDEF USE_SKINS} ipSkinManager, {$ENDIF} Trpcb, //needed for .ptype types ValEdit, SortStringGrid; type tFileEntry = record Field : string; FileNum : string; FieldName : String; IENS : string; oldValue,newValue : string; end; TGridInfo = class; //forward declaration TGridDataLoader = procedure (GridInfo: TGridInfo) of object; TGridInfo = class (TObject) public Grid : TSortStringGrid; //doesn't own object FileNum : string; IENS : string; BasicMode : Boolean; Data : TStringList; //doesn't own object Message : string; //optional text. DataLoadProc : TGridDataLoader; ApplyBtn : TButton; RevertBtn : TButton; end; TMainForm = class(TForm) PageControl: TPageControl; tsUsers: TTabSheet; UsersTreeView: TTreeView; UserPageControl: TPageControl; tsBasicPage: TTabSheet; tsAdvancedPage: TTabSheet; RightPanel: TPanel; ButtonPanel: TPanel; btnUsersApply: TBitBtn; btnUsersRevert: TBitBtn; LeftPanel: TPanel; Splitter1: TSplitter; Panel5: TPanel; ApplicationEvents: TApplicationEvents; AdvancedUsersGrid: TSortStringGrid; BasicUsersGrid: TSortStringGrid; MainMenu: TMainMenu; FileMenu: TMenuItem; ExitMenuItem: TMenuItem; AboutMenu: TMenuItem; CloneBtn: TBitBtn; ImageList1: TImageList; tsSettings: TTabSheet; Panel1: TPanel; Panel2: TPanel; SettingsPageControl: TPageControl; tsBasicSettings: TTabSheet; BasicSettingsGrid: TSortStringGrid; tsAdvancedSettings: TTabSheet; AdvancedSettingsGrid: TSortStringGrid; Panel3: TPanel; btnSettingsApply: TBitBtn; btnSettingsRevert: TBitBtn; Panel4: TPanel; SettingsTreeView: TTreeView; Panel6: TPanel; Splitter2: TSplitter; tsPatients: TTabSheet; Panel7: TPanel; Splitter3: TSplitter; Panel8: TPanel; PatientsPageControl: TPageControl; tsBasicPatients: TTabSheet; BasicPatientGrid: TSortStringGrid; tsAdvancedPatients: TTabSheet; AdvancedPatientGrid: TSortStringGrid; Panel9: TPanel; btnPatientApply: TBitBtn; btnPatientRevert: TBitBtn; Panel10: TPanel; Panel11: TPanel; AddBtn: TBitBtn; PatientORComboBox: TORComboBox; tsAdvanced: TTabSheet; Panel12: TPanel; Splitter4: TSplitter; RtAdvPanel: TPanel; AnyFilePageControl: TPageControl; TabSheet2: TTabSheet; AnyFileGrid: TSortStringGrid; Panel14: TPanel; btnAdvancedApply: TBitBtn; btnAdvancedRevert: TBitBtn; LeftAdvPanel: TPanel; BotLeftAdvBtnPanel: TPanel; btnAddAnyRecord: TBitBtn; FileORComboBox: TORComboBox; Label1: TLabel; RecordORComboBox: TORComboBox; Label2: TLabel; TopLeftAdvPanel: TPanel; BotLeftAdvPanel: TPanel; Splitter5: TSplitter; Panel13: TPanel; btnBatchAdd: TBitBtn; procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); procedure GridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure FormDestroy(Sender: TObject); procedure UsersTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean); procedure UsersTreeViewChange(Sender: TObject; Node: TTreeNode); procedure Button1Click(Sender: TObject); procedure btnUsersRevertClick(Sender: TObject); procedure btnUsersApplyClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure ExitMenuItemClick(Sender: TObject); procedure UserPageControlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); procedure AboutMenuClick(Sender: TObject); procedure CloneBtnClick(Sender: TObject); procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean); procedure ApplicationEventsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo); procedure SettingsTreeViewChange(Sender: TObject; Node: TTreeNode); procedure SettingsTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean); procedure BasicSettingsGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); procedure PageControlChanging(Sender: TObject; var AllowChange: Boolean); procedure UserPageControlChanging(Sender: TObject; var AllowChange: Boolean); procedure PatientORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure PageControlChange(Sender: TObject); procedure PatientORComboBoxClick(Sender: TObject); procedure PatientsPageControlChanging(Sender: TObject; var AllowChange: Boolean); procedure SettingsPageControlChanging(Sender: TObject; var AllowChange: Boolean); procedure PatientsPageControlChange(Sender: TObject); procedure SettingsPageControlChange(Sender: TObject); procedure UserPageControlChange(Sender: TObject); procedure FileORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure FileORComboBoxClick(Sender: TObject); procedure RecordORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure RecordORComboBoxClick(Sender: TObject); procedure btnAddAnyRecordClick(Sender: TObject); procedure AddBtnClick(Sender: TObject); procedure btnAdvancedApplyClick(Sender: TObject); procedure btnAdvancedRevertClick(Sender: TObject); procedure AnyFileGridClick(Sender: TObject); procedure btnBatchAddClick(Sender: TObject); procedure ChangeSkinClick(Sender: TObject); procedure btnPatientApplyClick(Sender: TObject); procedure btnPatientRevertClick(Sender: TObject); procedure BasicPatientGridClick(Sender: TObject); procedure ApplicationEventsException(Sender: TObject; E: Exception); procedure btnSettingsRevertClick(Sender: TObject); procedure btnSettingsApplyClick(Sender: TObject); private { Private declarations } CurrentUserData : TStringList; CurrentSettingsData : TStringList; CurrentPatientData : TStringList; CurrentAnyFileData : TStringList; BasicTemplate : TStringList; AllUsers : TTreeNode; AllSettings : TTreeNode; ActiveUsers : TTreeNode; InactiveUsers : TTreeNode; SettingsFiles : TStringList; KernelSysParams : TTreeNode; HospLoc : TTreeNode; RPCBrokerParams : TTreeNode; Devices : TTreeNode; FLastSelectedRow,FLastSelectedCol : integer; FLoadingGrid: boolean; DataForGrid : TStringList; // doesn't own TGridInfo objects CachedHelp : TStringList; CachedHelpIdx : TStringList; CachedWPField : TStringList; FVisibleGridIdx : integer; FINIFileName : string; // 8-12-09 elh procedure ShowDebugClick(Sender: TObject); function FindParam(Param : string) : string; function GetCurrentUserName : string; procedure SetCursorImage(Cursor : TCursor); function FileNumForSettingsNode (Node : TTreeNode) : string; function GetVisibleGrid: TSortStringGrid; function GetVisibleGridInfo : TGridInfo; function GetInfoForGrid(Grid : TSortStringGrid) : TGridInfo; function GetInfoIndexForGrid(Grid : TSortStringGrid) : integer; procedure SetVisibleGridIdx(Grid : TSortStringGrid); procedure GetUsersList(UsersList : TStringList; HideInactive: boolean); procedure GetRecordsList(RecordsList : TStringList; FileNum : string); procedure InitializeUsersTreeView; procedure InitializeSettingsFilesTreeView; procedure InitUsersStuff; procedure InitSettingsFilesStuff; Procedure LoadUsersTreeView(UsersList : TStringList); Procedure LoadSettingsTreeView(RecordsList : TStringList;DestNode : TTreeNode); //procedure LoadUserData(IENS : String; Data : TStringList); procedure LoadUserData(GridInfo : TGridInfo); //procedure GetSettingsInfo(FileNum : String; IENS : String; Data : TStringList); procedure GetSettingsInfo(GridInfo : TGridInfo); procedure GetPatientInfo(GridInfo : TGridInfo); //procedure GetPatientInfo(IENS : String; Data : TStringList); procedure GetAnyfileInfo(GridInfo : TGridInfo); //procedure GetAnyfileInfo(FileNum : String; IENS : String; Data : TStringList); function FindInStrings(fieldNum : string; Strings : TStringList; var fileNum : string) : integer; procedure CompileChanges(Grid : TSortStringGrid; CurrentUserData,Changes : TStringList); function PostChanges(Grid : TSortStringGrid) : TModalResult; function PostVisibleGrid: TModalResult; procedure LoadAnyGrid(Grid : TSortStringGrid; BasicMode: boolean; FileNum,IENS : string; CurrentData : TStringList); function DisuserChanged(Changes: TStringList) : boolean; procedure DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); function DoCloneRecord(FileNum, SourceIENS, New01Field : String) : string; function DoCloneUser(SourceIENS, New01Field : String) : string; function GetGridHint(Grid : TSortStringGrid; FileNum : string; ACol, ARow : integer) : string; function FieldHelp(FileNum, IENS, FieldNum, HelpStyle : string) : string; procedure DoRevert(BasicGrid,AdvancedGrid : TSortStringGrid); public { Public declarations } CurrentUserName: string; LastSelTreeNode : TTreeNode; DebugMode : boolean; function GetUserLine(CurrentUserData : TStringList; Grid : TSortStringGrid; ARow:integer) :integer; function GetLineInfo(Grid : TSortStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry; function IsSubFile(FieldDef: string ; var SubFileNum : string) : boolean; function IsWPField(FileNum,FieldNum : string) : boolean; function ExtractNum (S : String; StartPos : integer) : string; procedure Initialize; procedure InitORComboBox(ORComboBox: TORComboBox; initValue : string); Procedure GetBlankFileInfo(FileNum : string; BlankList : TStringList); procedure GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo : TStringList); procedure AddGridInfo(Grid: TSortStringGrid; Data : TStringList; BasicMode : boolean; DataLoader : TGridDataLoader; FileNum : string; ApplyBtn,RevertBtn : TButton); procedure LoadAnyGridFromInfo(GridInfo : TGridInfo); procedure ClearGrid(Grid : TSortStringGrid); procedure RegisterGridInfo(GridInfo : TGridInfo); procedure UnRegisterGridInfo(GridInfo : TGridInfo); end; var MainForm: TMainForm; Const DEF_GRID_ROW_HEIGHT = 17; CLICK_FOR_SUBS = ''; COMPUTED_FIELD = ' CAN''T EDIT>'; CLICK_TO_EDIT = ''; HIDDEN_FIELD = ''; implementation uses frmSplash, LookupU, SubfilesU, SetSelU, SelDateTimeU, PostU, FMErrorU, AboutU, PleaseWaitU, EditTextU, CreateTemplateU, SkinFormU, BatchAddU, DebugU, inifiles; //8-12-09 elh {$R *.dfm} const RPC_CONTEXT = 'TMG RPC CONTEXT GUI_CONFIG'; procedure TMainForm.Initialize; var tempMenu,tempSubMenu : TMenuItem; begin DebugMode := (FindParam('debug')='enable'); if DebugMode then begin DebugForm.show; tempMenu := TMenuItem.Create(FileMenu); tempMenu.Caption := '&Show Debug Log'; tempMenu.OnClick := ShowDebugClick; FileMenu.Add(tempMenu); end else begin DebugForm.Hide; end; {$IFDEF USE_SKINS} DebugForm.Memo.Lines.Add('Adding Menus'); tempMenu := TMenuItem.Create(MainMenu); tempMenu.Caption := '&Appearance'; tempSubMenu := TMenuItem.Create(tempMenu); tempSubMenu.Caption := '&Change Skin'; tempSubMenu.OnClick := ChangeSkinClick; tempMenu.Add(tempSubMenu); MainMenu.Items.Add(tempMenu); {$ENDIF} DebugForm.Memo.Lines.Add('Showing Splash'); SplashForm.show; FLoadingGrid := false; SettingsFiles := TStringList.Create; CurrentUserData := TStringList.create; CurrentSettingsData := TStringList.Create; CurrentPatientData := TStringList.Create; CurrentAnyFileData := TStringList.Create; DataForGrid := TStringList.Create; //will own GridInfo objects. CachedHelp := TStringList.Create; CachedHelpIdx := TStringList.Create; CachedWPField := TStringList.Create; DebugForm.Memo.Lines.Add('Adding Grid Info'); AddGridInfo(BasicUsersGrid,CurrentUserData,true,LoadUserData,'200',btnUsersApply,btnUsersRevert); AddGridInfo(AdvancedUsersGrid,CurrentUserData,false,LoadUserData,'200',btnUsersApply,btnUsersRevert); AddGridInfo(BasicSettingsGrid,CurrentSettingsData,true,GetSettingsInfo,'',btnSettingsApply,btnSettingsRevert); AddGridInfo(AdvancedSettingsGrid,CurrentSettingsData,false,GetSettingsInfo,'',btnSettingsApply,btnSettingsRevert); AddGridInfo(BasicPatientGrid,CurrentPatientData,true,GetPatientInfo,'2',btnPatientApply,btnPatientRevert); AddGridInfo(AdvancedPatientGrid,CurrentPatientData,false,GetPatientInfo,'2',btnPatientApply,btnPatientRevert); AddGridInfo(AnyFileGrid,CurrentAnyFileData,false,GetAnyFileInfo,'',btnAdvancedApply,btnAdvancedRevert); MainForm.Visible := false; DebugForm.Memo.Lines.Add('Trying to connect to server'); if not ORNet.ConnectToServer(RPC_CONTEXT) then begin DebugForm.Memo.Lines.Add('Failed connection. Closing.'); messagedlg('Login Failed.',mtError,[mbOK],0); Close; Exit; end; DebugForm.Memo.Lines.Add('Connected to server!'); Application.ProcessMessages; LastSelTreeNode := nil; RPCBrokerV.ClearParameters := true; BasicTemplate := TStringList.create; BasicTemplate.Sorted := false; DebugForm.Memo.Lines.Add('Initializing Combo Boxes'); InitORCombobox(PatientORComboBox,'A'); InitORCombobox(FileORComboBox,'A'); InitUsersStuff; InitSettingsFilesStuff; CurrentUserName := GetCurrentUserName; PageControl.ActivePage := tsUsers; UserPageControl.ActivePage := tsBasicPage; SettingsPageControl.ActivePage := tsBasicSettings; PageControlChange(nil); //ensure VisibleGridIdx is initialized. {$IFDEF USE_SKINS} if SkinForm.cbSkinAtStartup.Checked then begin DebugForm.Memo.Lines.Add('Activating Skins'); SkinForm.ActivateCurrentSkin; end; {$ENDIF} self.Visible := true; SplashForm.Hide; DebugForm.Memo.Lines.Add('Done Initializing.'); end; function TMainForm.FindParam(Param : string) : string; //Searches command line parameters for Param. If found, then value returned. //Case insensitive //Must be in 'param=value' format, i.e. must have '=' var i : integer; tempS : string; begin Result := ''; Param := LowerCase(Param); for i := 1 to ParamCount do begin tempS := LowerCase (ParamStr(i)); if Pos(Param,tempS)>0 then Result := Piece(tempS,'=',2); end; end; procedure TMainForm.AddGridInfo(Grid: TSortStringGrid; Data : TStringList; BasicMode : boolean; DataLoader : TGridDataLoader; FileNum : string; ApplyBtn,RevertBtn : TButton ); var tempGridInfo : TGridInfo; begin tempGridInfo := TGridInfo.Create; tempGridInfo.Grid := Grid; tempGridInfo.Data := Data; tempGridInfo.BasicMode := BasicMode; tempGridInfo.FileNum := FileNum; tempGridInfo.DataLoadProc := DataLoader; tempGridInfo.ApplyBtn := ApplyBtn; tempGridInfo.RevertBtn := RevertBtn; RegisterGridInfo(tempGridInfo); end; procedure TMainForm.RegisterGridInfo(GridInfo : TGridInfo); var s : string; begin if GridInfo = nil then exit; s := IntToStr(integer(GridInfo.Grid)); DataForGrid.AddObject(s,GridInfo); end; procedure TMainForm.UnRegisterGridInfo(GridInfo : TGridInfo); var s : string; i : integer; begin if GridInfo = nil then exit; s := IntToStr(integer(GridInfo.Grid)); i := DataForGrid.IndexOf(s); if i > -1 then DataForGrid.Delete(i); end; function TMainForm.GetCurrentUserName : string; var RPCResult : string; begin RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET CURRENT USER NAME'; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 if piece(RPCResult,'^',1)='-1' then begin CurrentUserName := ''; FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin result := piece(RPCResult,'^',3); end; end; procedure TMainForm.GetUsersList(UsersList : TStringList; HideInactive: boolean); var RPCResult : string; begin UsersList.Clear; RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.Param[0].Value := '.X'; // not used RPCBrokerV.param[0].ptype := list; RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET USER LIST'; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin UsersList.Assign(RPCBrokerV.Results); end; end; procedure TMainForm.GetRecordsList(RecordsList : TStringList; FileNum : string); //Format of Records list: // .01Value^IEN^FileNum // .01Value^IEN^FileNum var RPCResult : string; begin RecordsList.Clear; RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET RECORDS LIST^' + FileNum; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin RecordsList.Assign(RPCBrokerV.Results); end; end; Procedure TMainForm.LoadUsersTreeView(UsersList : TStringList); //UsersList Format: // Name^IEN^FileNum^Disuser(1 or 0) // Name^IEN^FileNum^Disuser(1 or 0) procedure AddChild(Parent : TTreeNode; Name : string;IEN : longInt); var Node : TTreeNode; begin Node := UsersTreeView.Items.AddChildObject(Parent,Name,pointer(IEN)); if Parent=InactiveUsers then begin Node.ImageIndex := 1; Node.SelectedIndex := 4; end else begin Node.ImageIndex := 0; Node.SelectedIndex := 5; end; end; var i : integer; oneEntry,Name,IENStr,inactive : string; IEN : longInt; begin for i := 1 to UsersList.Count-1 do begin oneEntry := UsersList.Strings[i]; Name := Piece(oneEntry,'^',1); IENStr := Piece(oneEntry,'^',2); inactive := Piece(oneEntry,'^',4); if (Pos('.',IENStr)=0) then begin IEN := StrToInt(IENStr); if (inactive='1') then begin AddChild(InactiveUsers,Name,IEN) end else begin AddChild(ActiveUsers,Name,IEN) end; end; end; End; Procedure TMainForm.LoadSettingsTreeView(RecordsList : TStringList;DestNode : TTreeNode); //RecordsList Format: // .01Value^IEN^FileNum // .01Value^IEN^FileNum //Note: Will ADD into tree view, leaving prior entries intact var i : integer; oneEntry,Name,IENStr : string; IEN : longInt; Node: TTreeNode; begin for i := 1 to RecordsList.Count-1 do begin oneEntry := RecordsList.Strings[i]; Name := Piece(oneEntry,'^',1); IENStr := Piece(oneEntry,'^',2); IEN := StrToInt(IENStr); Node := UsersTreeView.Items.AddChildObject(DestNode,Name,pointer(IEN)); Node.ImageIndex := 9; //change later for icon Node.SelectedIndex := 10; //change later for icon end; End; procedure TMainForm.InitUsersStuff; begin BasicTemplate.Add('200^.01'); //Name BasicTemplate.Add('200^1'); //initials BasicTemplate.Add('200^13'); //Nickname BasicTemplate.Add('200^10.6'); //Degree BasicTemplate.Add('200^53.2'); //DEA# BasicTemplate.Add('200^2'); //Access Code BasicTemplate.Add('200^11'); //Verify Code BasicTemplate.Add('200^7'); //DISUSER BasicTemplate.Add('200^20.2'); //Signature block printed name BasicTemplate.Add('200^20.3'); //Signature block title BasicTemplate.Add('200^20.4'); //Electronic signature code BasicTemplate.Add('200^51'); //Keys BasicTemplate.Add('200^8932.1');//Person class BasicTemplate.Add('200^53.5'); //Provider class BasicTemplate.Add('200^53.7'); //Requires cosigner BasicTemplate.Add('200^53.8'); //Usually cosigner BasicTemplate.Add('200^101.13'); //CPRS TAb BasicTemplate.Add('200^200.1');//Timed read #sec BasicTemplate.Add('200^201'); //Primary menu option InitializeUsersTreeView; end; procedure TMainForm.InitSettingsFilesStuff; begin // -- KERNEL SYSTEM PARAMETERS BasicTemplate.Add('8989.3^.01'); // DOMAIN NAME BasicTemplate.Add('8989.3^202'); // DEFAULT # OF ATTEMPTS BasicTemplate.Add('8989.3^203'); // DEFAULT LOCK-OUT TIME BasicTemplate.Add('8989.3^204'); // DEFAULT MULTIPLE SIGN-ON BasicTemplate.Add('8989.3^205'); // ASK DEVICE TYPE AT SIGN-ON BasicTemplate.Add('8989.3^206'); // DEFAULT AUTO-MENU BasicTemplate.Add('8989.3^207'); // DEFAULT LANGUAGE BasicTemplate.Add('8989.3^209'); // DEFAULT TYPE-AHEAD BasicTemplate.Add('8989.3^210'); // DEFAULT TIMED-READ (SECONDS) BasicTemplate.Add('8989.3^214'); // LIFETIME OF VERIFY CODE BasicTemplate.Add('8989.3^217'); // DEFAULT INSTITUTION BasicTemplate.Add('8989.3^218'); // DEFAULT AUTO SIGN-ON BasicTemplate.Add('8989.3^219'); // DEFAULT MULTIPLE SIGN-ON LIMIT BasicTemplate.Add('8989.3^230'); // BROKER ACTIVITY TIMEOUT BasicTemplate.Add('8989.3^240'); // INTRO MESSAGE BasicTemplate.Add('8989.3^245'); // POST SIGN-IN MESSAGE BasicTemplate.Add('8989.3^320'); // DEFAULT DIRECTORY FOR HFS BasicTemplate.Add('8989.3^501'); // PRODUCTION account // -- HOSPITAL LOCATION BasicTemplate.Add('44^.01'); // NAME BasicTemplate.Add('44^1'); // ABBREVIATION BasicTemplate.Add('44^2'); // TYPE BasicTemplate.Add('44^2.1'); // TYPE EXTENSION BasicTemplate.Add('44^3'); // INSTITUTION BasicTemplate.Add('44^3.5'); // DIVISION BasicTemplate.Add('44^5'); // DEFAULT DEVICE BasicTemplate.Add('44^9'); // SERVICE BasicTemplate.Add('44^9.5'); // TREATING SPECIALTY BasicTemplate.Add('44^10'); // PHYSICAL LOCATION BasicTemplate.Add('44^15'); // CATEGORY OF VISIT BasicTemplate.Add('44^16'); // DEFAULT PROVIDER BasicTemplate.Add('44^23'); // AGENCY BasicTemplate.Add('44^29'); // CLINIC SERVICES RESOURCE BasicTemplate.Add('44^99'); // TELEPHONE BasicTemplate.Add('44^101'); // ASSOCIATED LOCATION TYPES BasicTemplate.Add('44^1916'); // PRINCIPAL CLINIC BasicTemplate.Add('44^2505'); // INACTIVATE DATE BasicTemplate.Add('44^2506'); // REACTIVATE DATE BasicTemplate.Add('44^2507'); // DEFAULT APPOINTMENT TYPE BasicTemplate.Add('44^2508'); // NO SHOW LETTER BasicTemplate.Add('44^2509'); // PRE-APPOINTMENT LETTER BasicTemplate.Add('44^2510'); // CLINIC CANCELLATION LETTER BasicTemplate.Add('44^2511'); // APPT. CANCELLATION LETTER BasicTemplate.Add('44^2600'); // PROVIDER BasicTemplate.Add('44^2700'); // DIAGNOSIS BasicTemplate.Add('44^2801'); // DEFAULT TO PC PRACTITIONER? // -- RPC BROKER SITE PARAMETERS BasicTemplate.Add('8994.1^.01'); // DOMAIN NAME BasicTemplate.Add('8994.1^2'); // MAIL GROUP FOR ALERTS BasicTemplate.Add('8994.1^7'); // LISTENER // -- DEVICE file BasicTemplate.Add('3.5^.01'); // NAME BasicTemplate.Add('3.5^.02'); // LOCATION OF TERMINAL BasicTemplate.Add('3.5^.03'); // MNEMONIC BasicTemplate.Add('3.5^.04'); // LOCAL SYNONYM BasicTemplate.Add('3.5^1'); // $I BasicTemplate.Add('3.5^1.95'); // SIGN-ON/SYSTEM DEVICE BasicTemplate.Add('3.5^2'); // TYPE BasicTemplate.Add('3.5^3'); // SUBTYPE BasicTemplate.Add('3.5^5.5'); // QUEUING BasicTemplate.Add('3.5^6'); // OUT-OF-SERVICE DATE BasicTemplate.Add('3.5^7'); // NEAREST PHONE BasicTemplate.Add('3.5^8'); // KEY OPERATOR BasicTemplate.Add('3.5^9'); // MARGIN WIDTH BasicTemplate.Add('3.5^11'); // PAGE LENGTH BasicTemplate.Add('3.5^16'); // CLOSEST PRINTER BasicTemplate.Add('3.5^19'); // OPEN PARAMETERS BasicTemplate.Add('3.5^19.3'); // CLOSE PARAMETERS BasicTemplate.Add('3.5^19.5'); // USE PARAMETERS BasicTemplate.Add('3.5^19.7'); // PRE-OPEN EXECUTE BasicTemplate.Add('3.5^19.8'); // POST-CLOSE EXECUTE BasicTemplate.Add('3.5^27'); // PASSWORD BasicTemplate.Add('3.5^51.5'); // ASK DEVICE TYPE AT SIGN-ON BasicTemplate.Add('3.5^51.6'); // AUTO MENU BasicTemplate.Add('3.5^51.9'); // TYPE-AHEAD // -- PATIENT file BasicTemplate.Add('2^.01'); // NAME BasicTemplate.Add('2^.02'); // SEX BasicTemplate.Add('2^.03'); // DATE OF BIRTH BasicTemplate.Add('2^.05'); // MARITAL STATUS BasicTemplate.Add('2^.06'); // RACE BasicTemplate.Add('2^.07'); // OCCUPATION BasicTemplate.Add('2^.08'); // RELIGIOUS PREFERENCE BasicTemplate.Add('2^.09'); // SOCIAL SECURITY NUMBER BasicTemplate.Add('2^.091'); // REMARKS BasicTemplate.Add('2^.092'); // PLACE OF BIRTH [CITY] BasicTemplate.Add('2^.093'); // PLACE OF BIRTH [STATE] BasicTemplate.Add('2^.096'); // WHO ENTERED PATIENT BasicTemplate.Add('2^.097'); // DATE ENTERED INTO FILE BasicTemplate.Add('2^.098'); // HOW WAS PATIENT ENTERED? BasicTemplate.Add('2^.103'); // TREATING SPECIALTY BasicTemplate.Add('2^.104'); // PROVIDER BasicTemplate.Add('2^.1041'); // ATTENDING PHYSICIAN BasicTemplate.Add('2^.111'); // STREET ADDRESS [LINE 1] BasicTemplate.Add('2^.1112'); // ZIP+4 BasicTemplate.Add('2^.112'); // STREET ADDRESS [LINE 2] BasicTemplate.Add('2^.113'); // STREET ADDRESS [LINE 3] BasicTemplate.Add('2^.114'); // CITY BasicTemplate.Add('2^.115'); // STATE BasicTemplate.Add('2^.116'); // ZIP CODE BasicTemplate.Add('2^.117'); // COUNTY BasicTemplate.Add('2^.131'); // PHONE NUMBER [RESIDENCE] BasicTemplate.Add('2^.132'); // PHONE NUMBER [WORK] BasicTemplate.Add('2^.133'); // PHONE [CELL} BasicTemplate.Add('2^.2401'); // FATHER'S NAME BasicTemplate.Add('2^.2402'); // MOTHER'S NAME BasicTemplate.Add('2^.2403'); // MOTHER'S MAIDEN NAME BasicTemplate.Add('2^994'); // MULTIPLE BIRTH INDICATOR BasicTemplate.Add('2^1901'); // VETERAN (Y/N)? InitializeSettingsFilesTreeView; end; procedure TMainForm.InitializeUsersTreeView; var UsersList : TStringList; begin CurrentUserData.Clear; ClearGrid(AdvancedUsersGrid); ClearGrid(BasicUsersGrid); UsersTreeView.Items.Clear; AllUsers := UsersTreeView.Items.Add(nil, 'All Users'); { Add root node } AllUsers.ImageIndex := 2; AllUsers.SelectedIndex := 2; ActiveUsers := UsersTreeView.Items.AddChild(AllUsers,'Active Users'); ActiveUsers.ImageIndex := 0; ActiveUsers.SelectedIndex := 0; InactiveUsers := UsersTreeView.Items.AddChild(AllUsers,'Inactive Users'); InactiveUsers.ImageIndex := 1; InactiveUsers.SelectedIndex := 1; AllUsers.Expand(true); UsersList := TStringList.create; UsersList.Sorted := false; GetUsersList(UsersList,false); LoadUsersTreeView(UsersList); UsersList.free; end; procedure TMainForm.InitializeSettingsFilesTreeView; var RecordsList : TStringList; index : integer; begin RecordsList := TStringList.Create; SettingsFiles.Clear; SettingsFiles.Add(''); // to index 0 is not used for file info. ClearGrid(AdvancedSettingsGrid); ClearGrid(BasicSettingsGrid); SettingsTreeView.Items.Clear; AllSettings := SettingsTreeView.Items.Add(nil, 'All Settings Files'); { Add root node } AllSettings.ImageIndex := 8; AllSettings.SelectedIndex := 8; AllSettings.StateIndex := 7; index := SettingsFiles.Add('8989.3'); KernelSysParams := SettingsTreeView.Items.AddChildObject(AllSettings,'Kernel System Parameters',Pointer(index)); KernelSysParams.ImageIndex := 8; KernelSysParams.SelectedIndex := 8; KernelSysParams.StateIndex := 7; GetRecordsList(RecordsList,'8989.3'); // KERNEL SYSTEM PARAMETERS file LoadSettingsTreeView(RecordsList,KernelSysParams); RecordsList.Clear; index := SettingsFiles.Add('44'); HospLoc := SettingsTreeView.Items.AddChildObject(AllSettings,'Practice Locations',Pointer(index)); HospLoc.ImageIndex := 8; HospLoc.SelectedIndex := 8; HospLoc.StateIndex := 7; GetRecordsList(RecordsList,'44'); //HOSPITAL LOCATION file LoadSettingsTreeView(RecordsList,HospLoc); RecordsList.Clear; index := SettingsFiles.Add('8994.1'); RPCBrokerParams := SettingsTreeView.Items.AddChildObject(AllSettings,'RPC Broker Settings',Pointer(index)); RPCBrokerParams.ImageIndex := 8; RPCBrokerParams.SelectedIndex := 8; RPCBrokerParams.StateIndex := 7; GetRecordsList(RecordsList,'8994.1'); // RPC BROKER SITE PARAMETERS LoadSettingsTreeView(RecordsList,RPCBrokerParams); RecordsList.Clear; index := SettingsFiles.Add('3.5'); Devices := SettingsTreeView.Items.AddChildObject(AllSettings,'Devices',Pointer(index)); Devices.ImageIndex := 8; Devices.SelectedIndex := 8; Devices.StateIndex := 7; GetRecordsList(RecordsList,'3.5'); // DEVICE LoadSettingsTreeView(RecordsList,Devices); RecordsList.Clear; RecordsList.Free; end; procedure TMainForm.FormDestroy(Sender: TObject); var i : integer; tempInfo : TGridInfo; begin CurrentUserData.Free; BasicTemplate.Free; SettingsFiles.Free; CurrentSettingsData.Free; CurrentPatientData.Free; CurrentAnyFileData.Free; for i := 0 to DataForGrid.Count-1 do begin tempInfo := TGridInfo(DataForGrid.Objects[i]); //tempInfo.Data.Free; //not owned here.... tempInfo.Free; end; DataForGrid.Free; CachedHelp.Free; CachedHelpIdx.Free; CachedWPField.Free; end; procedure TMainForm.UsersTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean); begin AllowChange := (PostVisibleGrid <> mrNO); if AllowChange then LastSelTreeNode := Node; end; function TMainForm.PostVisibleGrid: TModalResult; begin result := PostChanges(GetVisibleGrid); end; procedure TMainForm.SettingsTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean); begin AllowChange := (PostVisibleGrid <> mrNO); if AllowChange then LastSelTreeNode := Node; end; procedure TMainForm.UsersTreeViewChange(Sender: TObject; Node: TTreeNode); var IEN : longInt; GridInfo : TGridInfo; begin //get info from selected node. LastSelTreeNode := Node; IEN := longInt(Node.Data); if IEN = 0 then exit; GridInfo := GetInfoForGrid(BasicUsersGrid); if GridInfo = nil then exit; GridInfo.IENS := IntToStr(IEN) + ','; LoadUserData(GridInfo); end; procedure TMainForm.SettingsTreeViewChange(Sender: TObject; Node: TTreeNode); var IEN : longInt; FileNum : string; GridInfo : TGridInfo; begin //get info from selected node. LastSelTreeNode := Node; GridInfo := GetInfoForGrid(BasicSettingsGrid); if GridInfo = nil then exit; IEN := longInt(Node.Data); if IEN = 0 then exit; FileNum := FileNumForSettingsNode (Node); if FileNum = '' then exit; GridInfo.IENS := IntToStr(IEN) + ','; GridInfo.FileNum := FileNum; GetSettingsInfo(GridInfo); end; function TMainForm.FileNumForSettingsNode (Node : TTreeNode) : string; var index : integer; Parent : TTreeNode; begin Result := ''; Parent := Node.Parent; if Parent <> nil then begin index := integer(Parent.Data); if (index >0) and (index < SettingsFiles.count) then Result := SettingsFiles.Strings[index]; end; end; procedure TMainForm.LoadUserData(GridInfo : TGridInfo); //Purpose: Get all fields from server for one record. //Data is an OUT parameter. var cmd,RPCResult : string; IENS : String; Data : TStringList; begin Data := GridInfo.Data; IENS := GridInfo.IENS; Data.Clear; ClearGrid(AdvancedUsersGrid); ClearGrid(BasicUsersGrid); SetCursorImage(crHourGlass); if IENS <> '0,' then begin RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; cmd := 'GET ONE USER^' + IENS; RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin Data.Assign(RPCBrokerV.results); LoadAnyGrid(AdvancedUsersGrid,false,'200',IENS,Data); LoadAnyGrid(BasicUsersGrid,true,'200',IENS,Data); btnUsersRevert.Enabled := false; btnUsersApply.Enabled := false; end; end; SetCursorImage(crDefault); end; procedure TMainForm.SetCursorImage(Cursor : TCursor); begin BasicUsersGrid.Cursor := Cursor; AdvancedUsersGrid.Cursor := Cursor; UsersTreeView.Cursor := Cursor; BasicSettingsGrid.Cursor := Cursor; AdvancedSettingsGrid.Cursor := Cursor; SettingsTreeView.Cursor := Cursor; PatientORComboBox.Cursor := Cursor; BasicPatientGrid.Cursor := Cursor; AdvancedPatientGrid.Cursor := Cursor; end; procedure TMainForm.GetSettingsInfo(GridInfo : TGridInfo); //Purpose: Get all fields from server for one record. //Data is an OUT parameter. var cmd,RPCResult : string; FileNum : String; IENS : String; Data : TStringList ; begin FileNum := GridInfo.FileNum; IENS := GridInfo.IENS; Data := GridInfo.Data; Data.Clear; ClearGrid(AdvancedSettingsGrid); ClearGrid(BasicSettingsGrid); if IENS <> '0,' then begin RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS; RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin Data.Assign(RPCBrokerV.results); LoadAnyGrid(AdvancedSettingsGrid,false,FileNum,IENS,Data); LoadAnyGrid(BasicSettingsGrid,true,FileNum,IENS,Data); btnSettingsRevert.Enabled := false; btnSettingsApply.Enabled := false; end; end; end; procedure TMainForm.GetPatientInfo(GridInfo : TGridInfo); var cmd,RPCResult : string; IENS : String; Data : TStringList; begin IENS := GridInfo.IENS; Data := GridInfo.Data; Data.Clear; ClearGrid(AdvancedPatientGrid); ClearGrid(BasicPatientGrid); SetCursorImage(crHourGlass); if IENS <> '0,' then begin RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; cmd := 'GET ONE RECORD^2^' + IENS; RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin Data.Assign(RPCBrokerV.results); LoadAnyGrid(AdvancedPatientGrid,false,'2',IENS,Data); LoadAnyGrid(BasicPatientGrid,true,'2',IENS,Data); btnPatientRevert.Enabled := false; btnPatientApply.Enabled := false; end; end; SetCursorImage(crDefault); end; procedure TMainForm.GetAnyfileInfo(GridInfo : TGridInfo); //Purpose: Get all fields from server for one record. //Data is an OUT parameter. var cmd,RPCResult : string; FileNum : String; IENS : String; Data : TStringList; begin FileNum := GridInfo.FileNum; IENS := GridInfo.IENS; Data := GridInfo.Data; Data.Clear; ClearGrid(AnyFileGrid); if IENS <> '0,' then begin RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS; RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin Data.Assign(RPCBrokerV.results); LoadAnyGrid(AnyFileGrid,false,FileNum,IENS,Data); btnAdvancedRevert.Enabled := false; btnAdvancedApply.Enabled := false; end; end; end; procedure TMainForm.ClearGrid(Grid : TSortStringGrid); var i:integer; begin for i := 1 to 23 do begin //elh added to clear all data as some residual remained Grid.Cells[0,i] := ''; Grid.Cells[1,i] := ''; Grid.Cells[2,i] := ''; end; Grid.RowCount :=2; end; procedure TMainForm.LoadAnyGrid(Grid : TSortStringGrid; //the TSortStringGrid to load BasicMode: boolean; FileNum : string; IENS : string; CurrentData : TStringList); var GridInfo : TGridInfo; begin //This stores load information into GridInfo. GridInfo := GetInfoForGrid(Grid); if GridInfo = nil then exit; GridInfo.Grid := Grid; GridInfo.BasicMode := BasicMode; GridInfo.FileNum := FileNum; GridInfo.IENS := IENS; GridInfo.Data := CurrentData; LoadAnyGridFromInfo(GridInfo); end; procedure TMainForm.LoadAnyGridFromInfo(GridInfo : TGridInfo); //Format of CurrentData: //Data[0]=1^Success //Data[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... //Data[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo... //... //This assumes that GridInfo already has loaded info. var Grid : TSortStringGrid; //the TSortStringGrid to load BasicMode: boolean; FileNum : string; IENS : string; CurrentData : TStringList; procedure LoadOneLine (Grid : TSortStringGrid; oneEntry : string; GridRow : integer); var tempFile,IENS : string; fieldNum,fieldName,fieldDef : string; subFileNum : string; value : string; begin tempFile := Piece(oneEntry,'^',1); if tempFile = FileNum then begin //handle subfiles later... IENS := Piece(oneEntry,'^',2); fieldNum := Piece(oneEntry,'^',3); value := Piece(oneEntry,'^',4); fieldName := Piece(oneEntry,'^',5); fieldDef := Piece(oneEntry,'^',6); Grid.RowCount := GridRow + 1; Grid.Cells[0,GridRow] := fieldNum; Grid.Cells[1,GridRow] := fieldName; if Pos('W',fieldDef)>0 then begin Grid.Cells[2,GridRow] := CLICK_TO_EDIT; end else if IsSubFile(fieldDef, subFileNum) then begin if IsWPField(FileNum,fieldNum) then begin Grid.Cells[2,GridRow] := CLICK_TO_EDIT; end else begin Grid.Cells[2,GridRow] := CLICK_FOR_SUBS; end; end else if Pos('C',fieldDef)>0 then begin Grid.Cells[2,GridRow] := COMPUTED_FIELD; end else begin Grid.Cells[2,GridRow] := value; end; Grid.RowHeights[GridRow] := DEF_GRID_ROW_HEIGHT; end; end; function getOneLine(CurrentData : TStringList; oneFileNum,oneFieldNum : string) : string; var i : integer; FileNum,FieldNum : string; begin result := ''; // FileNum^IENS^FieldNum^FieldName^newValue^oldValue for i := 1 to CurrentData.Count - 1 do begin FileNum := piece(CurrentData.Strings[i],'^',1); if FileNum <> oneFileNum then continue; FieldNum := piece(CurrentData.Strings[i],'^',3); if FieldNum <> oneFieldNum then continue; result := CurrentData.Strings[i]; break; end; end; var i : integer; oneEntry : string; oneFileNum,oneFieldNum : string; gridRow : integer; //GridInfo : TGridInfo; begin FLoadingGrid := true; if GridInfo=nil then exit; Grid := GridInfo.Grid; BasicMode := GridInfo.BasicMode; FileNum := GridInfo.FileNum; IENS := GridInfo.IENS; CurrentData := GridInfo.Data; ClearGrid(Grid); Grid.ColWidths[0] := 50; Grid.ColWidths[1] := 200; Grid.ColWidths[2] := 300; Grid.Cells[0,0] := '#'; Grid.Cells[1,0] := 'Name'; Grid.Cells[2,0] := 'Value'; if BasicMode=false then begin for i := 1 to CurrentData.Count-1 do begin //start at 1 because [0] = 1^Success oneEntry := CurrentData.Strings[i]; LoadOneLine (Grid,oneEntry,i); end; end else if BasicMode=true then begin gridRow := 1; for i := 0 to BasicTemplate.Count-1 do begin oneFileNum := Piece(BasicTemplate.Strings[i],'^',1); if oneFileNum <> fileNum then continue; oneFieldNum := Piece(BasicTemplate.Strings[i],'^',2); oneEntry := getOneLine(CurrentData,oneFileNum,oneFieldNum); LoadOneLine (Grid,oneEntry,gridRow); Inc(GridRow); end; end; FLoadingGrid := false; end; procedure TMainForm.GridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); (* For Field def, here is the legend character meaning BC The data is Boolean Computed (true or false). C The data is Computed. Cm The data is multiline Computed. DC The data is Date-valued, Computed. D The data is Date-valued. F The data is Free text. I The data is uneditable. Pn The data is a Pointer reference to file "n". S The data is from a discrete Set of codes. N The data is Numeric-valued. Jn To specify a print length of n characters. Jn,d To specify printing n characters with decimals. V The data is a Variable pointer. W The data is Word processing. WL The Word processing data is normally printed in Line mode (i.e., without word wrap). *) var oneEntry,FieldDef : string; date,time: string; FileNum,FieldNum,SubFileNum : string; GridFileNum : string; UserLine : integer; Grid : TSortStringGrid; IEN : int64; IENS : string; CurrentData : TStringList; GridInfo : TGridInfo; SubFileForm : TSubFileForm; begin if FLoadingGrid then exit; //prevent pseudo-clicks during loading... Grid := (Sender as TSortStringGrid); GridInfo := GetInfoForGrid(Grid); if GridInfo=nil then exit; GridFileNum := GridInfo.FileNum; CanSelect := false; //default to NOT selectable. CurrentData := GridInfo.Data; if CurrentData=nil then exit; if CurrentData.Count = 0 then exit; UserLine := GetUserLine(CurrentData,Grid,ARow); if UserLine = -1 then exit; oneEntry := CurrentData.Strings[UserLine]; FieldDef := Piece(oneEntry,'^',6); if Pos('F',FieldDef)>0 then begin //Free text CanSelect := true; end else if IsSubFile(FieldDef,SubFileNum) then begin //Subfiles. FileNum := Piece(oneEntry,'^',1); FieldNum := Piece(oneEntry,'^',3); if IsWPField(FileNum,FieldNum) then begin IENS := Piece(oneEntry,'^',2); EditTextForm.PrepForm(FileNum,FieldNum,IENS); EditTextForm.ShowModal; end else begin //handle subfiles here IENS := ''; if GridInfo.Message = MSG_SUB_FILE then begin //used message from subfile Grid IENS := GridInfo.IENS; end else if LastSelTreeNode <> nil then begin //this is one of the selction trees. IEN := longInt(LastSelTreeNode.Data); if IEN > 0 then IENS := InttoStr(IEN) + ','; end else if GridInfo.Data = CurrentAnyFileData then begin IEN := RecordORComboBox.ItemID; //get info from selected record if IEN > 0 then IENS := InttoStr(IEN) + ','; end; if IENS <> '' then begin SubFileForm := TSubFileForm.Create(self); SubFileForm.PrepForm(SubFileNum,IENS); SubfileForm.ShowModal; // note: may call this function again recursively for sub-sub-files etc. SubFileForm.Free; end else begin MessageDlg('IENS for File="". Can''t process.',mtInformation,[MBOK],0); end; end; end else if Pos('C',FieldDef)>0 then begin //computed fields. CanSelect := false; end else if Pos('D',FieldDef)>0 then begin //date field date := piece(Grid.Cells[ACol,ARow],'@',1); time := piece(Grid.Cells[ACol,ARow],'@',2); if date <> '' then begin SelDateTimeForm.DateTimePicker.Date := StrToDate(date); end else begin SelDateTimeForm.DateTimePicker.Date := SysUtils.Date; end; if SelDateTimeForm.ShowModal = mrOK then begin date := DateToStr(SelDateTimeForm.DateTimePicker.Date); time := TimeToStr(SelDateTimeForm.DateTimePicker.Time); if time <> '' then date := date; // + '@' + time; elh 8/15/08 Grid.Cells[ACol,ARow] := date; end; CanSelect := true; end else if Pos('S',FieldDef)>0 then begin //Set of Codes SetSelForm.PrepForm(Piece(oneEntry,'^',7)); if SetSelForm.ShowModal = mrOK then begin Grid.Cells[ACol,ARow] := SetSelForm.ComboBox.Text; CanSelect := true; end; end else if Pos('I',FieldDef)>0 then begin //uneditable MessageDlg('Sorry. Flagged as UNEDITABLE.',mtInformation ,[mbOK],0); end else if Pos('P',FieldDef)>0 then begin //Pointer to file. FileNum := ExtractNum (FieldDef,Pos('P',FieldDef)+1); //check for validity here... FieldLookupForm.PrepForm(FileNum,Grid.Cells[ACol,ARow]); if FieldLookupForm.ShowModal = mrOK then begin Grid.Cells[ACol,ARow] := FieldLookupForm.ORComboBox.Text; CanSelect := true; end; end; if CanSelect then begin FLastSelectedRow := ARow; FLastSelectedCol := ACol; end; GridInfo.ApplyBtn.Enabled := true; GridInfo.RevertBtn.Enabled := true; end; function TMainForm.GetLineInfo(Grid : TSortStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry; var fieldNum : string; oneEntry : string; fileNum : string; gridRow : integer; begin fieldNum := Grid.Cells[0,ARow]; gridRow := FindInStrings(fieldNum, CurrentUserData, fileNum); if gridRow > -1 then begin oneEntry := CurrentUserData.Strings[gridRow]; Result.Field := fieldNum; Result.FieldName := Grid.Cells[1,ARow]; Result.FileNum := fileNum; Result.IENS := Piece(oneEntry,'^',2); Result.oldValue := Piece(oneEntry,'^',4); Result.newValue := Grid.Cells[2,ARow]; end else begin Result.Field := ''; Result.FieldName := ''; Result.FileNum := ''; Result.IENS := ''; Result.oldValue := ''; Result.newValue := ''; end; end; function TMainForm.GetUserLine(CurrentUserData : TStringList; Grid : TSortStringGrid; ARow: integer) : integer; var fieldNum: string; tempFileNum : string; begin fieldNum := Grid.Cells[0,ARow]; Result := FindInStrings(fieldNum,CurrentUserData,tempFileNum); end; function TMainForm.FindInStrings(fieldNum : string; Strings : TStringList; var fileNum : string) : integer; //Note: if fileNum is passed blank, then first matching file will be placed in it (i.e. OUT parameter) var tempFieldNum : string; oneEntry,tempFile : string; i : integer; begin result := -1; fileNum := ''; for i := 1 to Strings.Count-1 do begin //0 --> 1^success oneEntry := Strings.Strings[i]; tempFile := Piece(oneEntry,'^',1); if fileNum='' then fileNum := tempFile; if tempFile <> fileNum then continue; //ignore subfiles tempFieldNum := Piece(oneEntry,'^',3); if tempFieldNum <> fieldNum then continue; Result := i; break; end; end; function TMainForm.IsSubFile(FieldDef: string ; var SubFileNum : string) : boolean; //SubFileNum is OUT parameter begin SubFileNum := ExtractNum(FieldDef,1); result := (SubFileNum <> ''); end; function TMainForm.IsWPField(FileNum,FieldNum : string) : boolean; var RPCResult : string; SrchStr : string; Idx: integer; begin SrchStr := FileNum + '^' + FieldNum + '^'; Idx := CachedWPField.IndexOf(SrchStr + 'YES'); if Idx > -1 then begin Result := true; exit; end; Idx := CachedWPField.IndexOf(SrchStr + 'NO'); if Idx > -1 then begin Result := false; exit; end; result := false; RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'IS WP FIELD^' + FileNum + '^' + FieldNum; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin RPCResult := piece(RPCResult,'^',3); result := (RPCResult = 'YES'); CachedWPField.Add(SrchStr + RPCResult); end; end; function TMainForm.ExtractNum (S : String; StartPos : integer) : string; var i : integer; ch : char; begin result := ''; if (S = '') or (StartPos < 0) then exit; i := StartPos; repeat ch := S[i]; i := i + 1; if ch in ['0'..'9','.'] then begin Result := Result + ch; end; until (i > length(S)) or not (ch in ['0'..'9','.']) end; procedure TMainForm.Button1Click(Sender: TObject); begin FieldLookupForm.Show; end; procedure TMainForm.btnUsersRevertClick(Sender: TObject); begin DoRevert(BasicUsersGrid,AdvancedUsersGrid); { LoadAnyGridFromInfo(GetInfoForGrid(AdvancedUsersGrid)); LoadAnyGridFromInfo(GetInfoForGrid(BasicUsersGrid)); btnUsersRevert.Enabled := false; btnUsersApply.Enabled := false; } end; function TMainForm.GetVisibleGridInfo : TGridInfo; begin result := GetInfoForGrid(GetVisibleGrid); end; function TMainForm.GetVisibleGrid: TSortStringGrid; begin if FVisibleGridIdx > -1 then begin result := TGridInfo(DataForGrid.Objects[FVisibleGridIdx]).Grid; end else begin result := nil; end; end; function TMainForm.GetInfoForGrid(Grid : TSortStringGrid) : TGridInfo; var i : integer; begin i := GetInfoIndexForGrid(Grid); if i > -1 then begin result := TGridInfo(DataForGrid.Objects[i]); end else begin result := nil; end; end; function TMainForm.GetInfoIndexForGrid(Grid : TSortStringGrid) : integer; var s : string; begin s := IntToStr(integer(Grid)); result := DataForGrid.IndexOf(s); end; procedure TMainForm.SetVisibleGridIdx(Grid : TSortStringGrid); begin FVisibleGridIdx := GetInfoIndexForGrid(Grid); end; procedure TMainForm.CompileChanges(Grid : TSortStringGrid; CurrentUserData,Changes : TStringList); //Output format: // FileNum^IENS^FieldNum^FieldName^newValue^oldValue var row : integer; Entry : tFileEntry; oneEntry : string; iniFile : TIniFile; // 8-12-09 elh UCaseOnly : boolean; begin FINIFileName := ExtractFilePath(ParamStr(0)) + 'GUI_Config.ini'; iniFile := TIniFile.Create(FINIFileName); //8-12-09 elh UCaseOnly := inifile.ReadBool('Settings','UCaseOnly',true); iniFile.Free; for row := 1 to Grid.RowCount-1 do begin Entry := GetLineInfo(Grid,CurrentUserData, row); //Reject any value containing a "^" //Do we need an @ here as well? if AnsiPos('^',Entry.newvalue) > 0 then begin //or (AnsiPos(':',Entry.newvalue) > 0) or (AnsiPos(';',Entry.newvalue) > 0) //elh Taken out because : used in time messagedlg('Invalid value entered for ' + Entry.Fieldname + #13 + #10 + #13 + #10 + 'Invalid Entry: ' + Entry.newvalue + #13 + #10 + 'Ignoring Value.',mtError,[mbOK],0); end else begin //if Entry.newValue = ' ' then Entry.newValue := ''; Entry.newValue := Trim(Entry.newvalue); if Entry.oldValue <> Entry.newValue then begin if (Entry.newValue <> CLICK_FOR_SUBS) and (Entry.newValue <> COMPUTED_FIELD) and (Entry.newValue <> CLICK_TO_EDIT) then begin oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName; //Test to see if change is an AV Code (2 or 11) or ES Code (20.4) in User File (200) //If so, make it uppercase. 8/12/09 elh if Entry.FileNum = '200' then begin if ((Entry.Field = '2') and (UCaseOnly = true)) or ((Entry.Field = '11') and (UCaseOnly = true)) or ((Entry.Field = '20.4') and (UCaseOnly = true)) then begin messagedlg('Converting ' + Entry.Fieldname + ' to uppercase for VistA interactivity.' +#13 +#10 + #13 +#10 + 'Old Value: ' + Entry.newvalue + ' ' + 'New Value: ' + Uppercase(Entry.newvalue), mtinformation,[mbOK],0); Entry.newValue := Uppercase(Entry.newValue); end; end; oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue; Changes.Add(oneEntry); end; end; end; end; end; function TMainForm.PostChanges(Grid : TSortStringGrid) : TModalResult; //Results: mrNone -- no post done (not needed) // mrCancel -- user pressed cancel on confirmation screen. // mrNo -- signals posting error. var Changes : TStringList; PostResult : TModalResult; CurrentData : TStringList; GridInfo : TGridInfo; IENS : string; begin Result := mrNone; //default to No changes GridInfo := GetInfoForGrid(Grid); if GridInfo=nil then exit; CurrentData := GridInfo.Data; if CurrentData=nil then exit; if CurrentData.Count = 0 then exit; IENS := GridInfo.IENS; if IENS='' then exit; Changes := TStringList.Create; CompileChanges(Grid,CurrentData,Changes); if Changes.Count>0 then begin PostForm.PrepForm(Changes); PostResult := PostForm.ShowModal; if PostResult = mrOK then begin if DisuserChanged(Changes) then begin //looks for change in file 200, field 4 InitializeUsersTreeView; end else begin if Pos('+',IENS)>0 then begin GridInfo.IENS := PostForm.GetNewIENS(IENS); end; if assigned(GridInfo.DataLoadProc) then begin GridInfo.DataLoadProc(GridInfo); end; { if CurrentData = CurrentUserData then begin LoadUserData(IENS,CurrentData); //reload record from server. end else if CurrentData = CurrentSettingsData then begin GetSettingsInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData); end else if CurrentData = CurrentPatientData then begin GetPatientInfo(GridInfo.IENS, CurrentData); end else if CurrentData = CurrentAnyFileData then begin GetAnyFileInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData); end; } end; end else if PostResult = mrNo then begin //mrNo is signal of post Error // show error... end; Result := PostResult; end else begin Result := mrNone; end; Changes.Free; end; function TMainForm.DisuserChanged(Changes: TStringList) : boolean; var i : integer; //Changes format: // FileNum^IENS^FieldNum^FieldName^newValue^oldValue begin result := false; for i := 0 to Changes.Count-1 do begin if piece(Changes.Strings[i],'^',1)<> '200' then continue; if piece(Changes.Strings[i],'^',4)<> 'DISUSER' then continue; result := true; break; end; end; procedure TMainForm.btnUsersApplyClick(Sender: TObject); var result : TModalResult; begin result:= PostVisibleGrid; if result <> mrNone then InitializeUsersTreeView; end; procedure TMainForm.GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); begin btnUsersRevert.Enabled := true; btnUsersApply.Enabled := true; end; procedure TMainForm.BasicSettingsGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); begin btnSettingsRevert.Enabled := true; btnSettingsApply.Enabled := true; end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin PostVisibleGrid; RPCBrokerV.Connected := false; //disconnect end; procedure TMainForm.ExitMenuItemClick(Sender: TObject); begin Close; end; procedure TMainForm.UserPageControlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); begin DrawTab(Control,TabIndex,Rect,Active); end; procedure TMainForm.DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); var oRect : TRect; sCaption,temp : String; iTop : Integer; iLeft : Integer; i : integer; begin oRect := Rect; temp := TPageControl(Control).Pages[TabIndex].Caption; for i := 1 to length(temp) do begin if temp[i] <> '&' then sCaption := sCaption + temp[i]; end; iTop := Rect.Top + ((Rect.Bottom - Rect.Top - Control.Canvas.TextHeight(sCaption)) div 2) + 1; iLeft := Rect.Left + ((Rect.Right - Rect.Left - Control.Canvas.TextWidth (sCaption)) div 2) + 1; if Active then begin Control.Canvas.Brush.Color := TColor($0000FFFF); //Bright yellow Control.Canvas.FillRect(Rect); // Frame3d(Control.Canvas,oRect,clBtnHighLight,clBtnShadow,3); end else begin Control.Canvas.Brush.Color := TColor($000079EFE8); //dull yellow Control.Canvas.FillRect(Rect); end; Control.Canvas.TextOut(iLeft,iTop,sCaption); end; procedure TMainForm.AboutMenuClick(Sender: TObject); begin AboutForm.show; end; procedure TMainForm.CloneBtnClick(Sender: TObject); var IEN : longInt; newName : string; IENS,newIENS : string; begin if btnUsersApply.Enabled then btnUsersApplyClick(self); //post any changes first. if MessageDlg('Clone user: '+LastSelTreeNode.Text+' --> New user?' + #10 + #13 + 'Note: This can not be undone.', mtConfirmation, mbOKCancel,0) = mrCancel then exit; IEN := longInt(LastSelTreeNode.Data); IENS := IntToStr(IEN) + ','; WaitForm.Show; newName := 'TEMP,MUST-EDIT'; newIENS := DoCloneUser(IENS,newName); InitializeUsersTreeView; //refresh UsersTreeView. WaitForm.Hide; MessageDlg('A new cloned user has been created,' + #10 + #13 + 'named: ' + newName + #10 + #13 + #10 + #13 + 'This user can be found in the ''Inactive users'' list,' + #10 + #13 + 'but must must be edited before it may be used.' + #10 + #13 + 'Edit it''s DISUSER field to a value of ''NO''' + #10 + #13 + 'to activate.',mtInformation,[mbOK],0); end; function TMainForm.DoCloneRecord(FileNum, SourceIENS, New01Field : String) : string; //Returns IENS of new record in FileNum, or '' if error var cmd,RPCResult : string; begin Result := ''; RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; cmd := 'CLONE RECORD' + '^' + FileNum + '^' + SourceIENS + '^' + New01Field; RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin result := piece(RPCResult,'^',3); end; end; function TMainForm.DoCloneUser(SourceIENS, New01Field : String) : string; //Returns IENS of new record in FileNum, or '' if error var cmd,RPCResult : string; begin Result := ''; RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; cmd := 'CLONE USER' + '^' + SourceIENS + '^' + New01Field; RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin result := piece(RPCResult,'^',3); end; end; function TMainForm.FieldHelp(FileNum, IENS, FieldNum, HelpStyle : string) : string; var RPCResult: string; cmd : string; SrchStr : string; Idx : integer; begin Result := ''; SrchStr := FileNum + '^' + FieldNum + '^' + HelpStyle + '^' + IENS; Idx := CachedHelpIdx.IndexOf(SrchStr); if Idx = -1 then begin RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.param[0].ptype := list; cmd := 'GET HELP MSG^' + SrchStr; RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin RPCBrokerV.Results.Delete(0); if RPCBrokerV.Results.Count > 0 then begin if RPCBrokerV.Results.Strings[RPCBrokerV.Results.Count-1]='' then begin RPCBrokerV.Results.Delete(RPCBrokerV.Results.Count-1); end; end; result := RPCBrokerV.Results.Text; if result = '' then result := ' '; //Maybe later replace text with "Enter F1 for more help." Result := AnsiReplaceText(Result,'Enter ''??'' for more help.',''); while Result[Length(Result)] in [#10,#13] do begin Result := AnsiLeftStr(Result,Length(Result)-1); end; Idx := CachedHelp.Add(result); CachedHelpIdx.AddObject(SrchStr,Pointer(Idx)); //Store index here to help stored in CachedHelp end; end else begin Idx := Integer(CachedHelpIdx.Objects[Idx]); if (Idx >= 0) and (Idx < CachedHelp.Count) then begin result := CachedHelp.Strings[Idx]; end; end; end; function TMainForm.GetGridHint(Grid : TSortStringGrid; FileNum : string; ACol, ARow : integer) : string; var fieldNum : string; GridInfo : TGridInfo; begin Result := ''; //Result := 'Row=' + IntToStr(ARow) + ', Col='+ IntToStr(ACol); if ARow > Grid.RowCount-1 then exit; if (ARow < 1) or (ACol < 0) then exit; if ACol=0 then begin Result := 'This is the database field NUMBER'; end else if ACol=1 then begin Result := 'This is the database field NAME'; end else begin fieldNum := Grid.Cells[0,ARow]; if Grid.Cells[ACol,ARow]=CLICK_FOR_SUBS then begin result := 'Clicking will open new window...'; end else if Grid.Cells[ACol,ARow]=COMPUTED_FIELD then begin result := 'This field can''t be edited'; end else if Grid.Cells[ACol,ARow]=HIDDEN_FIELD then begin result := 'Original value hidden. Click to edit new value.'; end else if Grid.Cells[ACol,ARow]=CLICK_TO_EDIT then begin result := 'Clicking will open new window...'; end else begin GridInfo := GetInfoForGrid(Grid); Result := FieldHelp(FileNum, GridInfo.IENS, fieldNum, '?'); end; end; end; procedure TMainForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean); begin end; (*ApplicationIdle*) procedure TMainForm.ApplicationEventsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo); var Pos : TPoint; Handle : Hwnd; ItemBuffer : array[0..256] of Char; ClassName : AnsiString; ACol,ARow : integer; VisibleGridInfo : TGridInfo; begin CanShow := true; //Label2.Caption := HintStr; Pos := Mouse.CursorPos; Handle := WindowFromPoint(Pos); if Handle = 0 then Exit; GetClassName(Handle, ItemBuffer, SizeOf(ItemBuffer)); ClassName := ItemBuffer; Windows.ScreenToClient(Handle, Pos); VisibleGridInfo := GetVisibleGridInfo; if VisibleGridInfo = nil then exit; if VisibleGridInfo.Grid = nil then exit; if (ClassName='TSortStringGrid') then begin VisibleGridInfo.Grid.MouseToCell(Pos.X,Pos.Y,ACol,ARow); HintInfo.HintStr := GetGridHint(VisibleGridInfo.Grid,VisibleGridInfo.FileNum,ACol, ARow); if HintInfo.HintStr = '' then CanShow := False; HintInfo.HideTimeout := 1000; HintInfo.ReshowTimeout := 2000; HintInfo.HintMaxWidth:= 300; //hint box width. end; end; procedure TMainForm.PageControlChanging(Sender: TObject; var AllowChange: Boolean); begin AllowChange := (PostVisibleGrid <> mrNO); if AllowChange then begin LastSelTreeNode := nil; end; end; procedure TMainForm.PatientORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); var Result : TStrings; begin Result := FieldLookUpForm.SubSetOfFile('2', StartFrom, Direction); TORComboBox(Sender).ForDataUse(Result); end; procedure TMainForm.PageControlChange(Sender: TObject); begin if (PageControl.ActivePage = tsUsers) then begin UserPageControlChange(nil); end else if (PageControl.ActivePage = tsSettings) then begin SettingsPageControlChange(nil); end else if (PageControl.ActivePage = tsPatients) then begin PatientsPageControlChange(nil); end else if (PageControl.ActivePage = tsAdvanced) then begin SetVisibleGridIdx(AnyFileGrid); end; end; procedure TMainForm.PatientORComboBoxClick(Sender: TObject); var IEN : longInt; ModalResult : TModalResult; GridInfo : TGridInfo; begin ModalResult := PostVisibleGrid; if ModalResult = mrNo then exit; IEN := PatientORComboBox.ItemIEN; //get info from selected patient if IEN = 0 then exit; GridInfo := GetInfoForGrid(BasicPatientGrid); if GridInfo = nil then exit; GridInfo.IENS := IntToStr(IEN)+','; GetPatientInfo(GridInfo); end; procedure TMainForm.PatientsPageControlChanging(Sender: TObject; var AllowChange: Boolean); begin AllowChange := (PostVisibleGrid <> mrNO); end; procedure TMainForm.PatientsPageControlChange(Sender: TObject); begin if PatientsPageControl.ActivePage = tsBasicPatients then begin SetVisibleGridIdx(BasicPatientGrid); end else begin SetVisibleGridIdx(AdvancedPatientGrid); end; end; procedure TMainForm.UserPageControlChanging(Sender: TObject; var AllowChange: Boolean); var result : TModalResult; begin result := PostVisibleGrid; AllowChange := (result <> mrNO); if (result <> mrNone) then begin InitializeUsersTreeView; end; end; procedure TMainForm.UserPageControlChange(Sender: TObject); begin if UserPageControl.ActivePage = tsBasicPage then begin SetVisibleGridIdx(BasicUsersGrid); end else begin SetVisibleGridIdx(AdvancedUsersGrid); end; end; procedure TMainForm.SettingsPageControlChanging(Sender: TObject; var AllowChange: Boolean); begin AllowChange := (PostVisibleGrid <> mrNO); end; procedure TMainForm.SettingsPageControlChange(Sender: TObject); begin if SettingsPageControl.ActivePage = tsBasicSettings then begin SetVisibleGridIdx(BasicSettingsGrid); end else begin SetVisibleGridIdx(AdvancedSettingsGrid); end; end; procedure TMainForm.FileORComboBoxClick(Sender: TObject); begin PostVisibleGrid; InitORCombobox(RecordORComboBox,''); ClearGrid(GetVisibleGrid); end; procedure TMainForm.FileORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); var Result : TStrings; begin Result := FieldLookUpForm.SubSetOfFile('1', StartFrom, Direction); TORComboBox(Sender).ForDataUse(Result); end; procedure TMainForm.RecordORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); var Result : TStrings; FileNum : string; begin FileNum := FileORComboBox.ItemID; Result := FieldLookUpForm.SubSetOfFile(FileNum, StartFrom, Direction); TORComboBox(Sender).ForDataUse(Result); end; procedure TMainForm.RecordORComboBoxClick(Sender: TObject); var ModalResult : TModalResult; IEN : LongInt; FileNum : String; GridInfo : TGridInfo; begin ModalResult := PostVisibleGrid; if ModalResult = mrNo then exit; FileNum := FileORComboBox.ItemID; IEN := RecordORComboBox.ItemID; //get info from selected record if IEN=0 then exit; GridInfo := GetInfoForGrid(AnyFileGrid); if GridInfo = nil then exit; GridInfo.IENS := IntToStr(IEN) + ','; GridInfo.FileNum := FileNum; GetAnyfileInfo(GridInfo); //GetAnyfileInfo(FileNum,IntToStr(IEN)+',',CurrentAnyFileData); end; procedure TMainForm.btnAddAnyRecordClick(Sender: TObject); var IENS, FileNum : string; BlankFileInfo : TStringList; begin BlankFileInfo := Tstringlist.Create; btnAdvancedRevert.Enabled := True; btnAdvancedApply.Enabled := True; FileNum := FileORComboBox.ItemID; IENS := '+1,'; GetOneRecord(FileNum,IENS,CurrentAnyFileData, BlankFileInfo); LoadAnyGridFromInfo(GetInfoForGrid(AnyFileGrid)); BlankFileInfo.Free; end; procedure TMainForm.AddBtnClick(Sender: TObject); var IENS : string; BlankFileInfo : TStringList; GridInfo : TGridInfo; begin BlankFileInfo := Tstringlist.Create; btnPatientRevert.Enabled := True; btnPatientApply.Enabled := True; GridInfo := GetVisibleGridInfo; IENS := '+1,'; GetOneRecord(GridInfo.FileNum, IENS, GridInfo.Data, BlankFileInfo); GridInfo.IENS := IENS; LoadAnyGridFromInfo(GridInfo); //load Basic or Advanced Grid if GridInfo.Grid = BasicPatientGrid then begin GridInfo := GetInfoForGrid(AdvancedPatientGrid) end else begin //Advanced grid is visible. GridInfo := GetInfoForGrid(BasicPatientGrid) end; GridInfo.IENS := IENS; LoadAnyGridFromInfo(GridInfo); // Load OTHER grid, Advanced or Basic grid. BlankFileInfo.Free; end; procedure TMainForm.btnAdvancedApplyClick(Sender: TObject); begin PostVisibleGrid; end; procedure TMainForm.btnAdvancedRevertClick(Sender: TObject); //var tempInfo: TGridInfo; begin DoRevert(nil,AnyFileGrid); { tempInfo := GetInfoForGrid(AnyFileGrid); LoadAnyGridFromInfo(tempInfo); tempInfo.ApplyBtn.Enabled := false; tempInfo.RevertBtn.Enabled := false; } end; procedure TMainForm.AnyFileGridClick(Sender: TObject); begin btnAdvancedApply.Enabled := True; btnAdvancedRevert.Enabled := True; end; procedure TMainForm.btnBatchAddClick(Sender: TObject); begin BatchAddForm.ShowModal; InitORCombobox(PatientORComboBox,'A'); end; procedure TMainForm.ShowDebugClick(Sender: TObject); begin DebugForm.Show; end; procedure TMainForm.ChangeSkinClick(Sender: TObject); var result : TModalResult; begin try result := SkinForm.ShowModal; case result of mrOK : SkinForm.ActivateCurrentSkin; mrNo : SkinForm.InactivateSkin; end; {case} except on EInvalidOperation do MessageDlg('Error1',mtInformation,[mbOK],0); else MessageDlg('Error Applying Skin. Please try another Skin.',mtInformation,[mbOK],0); end; end; procedure TMainForm.InitORComboBox(ORComboBox: TORComboBox; initValue : string); begin ORComboBox.Items.Clear; ORComboBox.Text := initValue; ORComboBox.InitLongList(initValue); if ORComboBox.Items.Count > 0 then begin ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2); end else begin ORComboBox.Text := ''; end; end; procedure TMainForm.btnPatientApplyClick(Sender: TObject); //Added elh 8/15/08 begin PostVisibleGrid; InitORCombobox(PatientORComboBox,'A'); end; procedure TMainForm.btnPatientRevertClick(Sender: TObject); //Added elh 8/15/08 //var tempInfo : TGridInfo; begin DoRevert(BasicUsersGrid,AdvancedUsersGrid); { tempInfo := GetInfoForGrid(AdvancedUsersGrid); LoadAnyGridFromInfo(tempInfo); tempInfo := GetInfoForGrid(BasicUsersGrid); LoadAnyGridFromInfo(tempInfo); tempInfo.ApplyBtn.Enabled := false; tempInfo.RevertBtn.Enabled := false; } end; procedure TMainForm.BasicPatientGridClick(Sender: TObject); //Added elh 8/15/08 begin btnPatientRevert.Enabled := true; btnPatientApply.Enabled := true; end; Procedure TMainForm.GetBlankFileInfo(FileNum : string; BlankList : TStringList); var RPCResult: string; //Returned format for BlankList is: //FileNum^^FieldNum^^FieldName^More DDInfo //FileNum^^FieldNum^^FieldName^More DDInfo begin RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.Param[0].Value := '.X'; // not used RPCBrokerV.param[0].ptype := list; RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET EMPTY ENTRY^' + FileNum; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 //Return Format is: FileNum^^FieldNum^^DDInfo... if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin BlankList.Assign(RPCBrokerV.Results); end; end; procedure TMainForm.GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo: TStringList); var cmd,RPCResult : string; i : integer; oneEntry : string; begin Data.Clear; if (IENS='') then exit; if Pos('+',IENS)=0 then begin //don't ask server to load +1 records. RPCBrokerV.remoteprocedure := 'TMG CHANNEL'; RPCBrokerV.Param[0].Value := '.X'; // not used RPCBrokerV.param[0].ptype := list; cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS; RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd; RPCBrokerV.Call; RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1 if piece(RPCResult,'^',1)='-1' then begin FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results); FMErrorForm.PrepMessage; FMErrorForm.ShowModal; end else begin Data.Assign(RPCBrokerV.Results); end; end else begin Data.Add('1^Success'); //to keep same as call to server if BlankFileInfo.Count = 0 then begin //Format is: FileNum^^FieldNum^^DDInfo... GetBlankFileInfo(FileNum,BlankFileInfo); end; for i := 1 to BlankFileInfo.Count-1 do begin //0 is 1^success oneEntry := BlankFileInfo.Strings[i]; SetPiece(oneEntry,'^',2,IENS); Data.Add(oneEntry); end; end; end; procedure TMainForm.ApplicationEventsException(Sender: TObject; E: Exception); begin if E.Message <> 'Cannot focus a disabled or invisible window' then begin ShowException(E,nil); end; end; procedure TMainForm.btnSettingsRevertClick(Sender: TObject); //var tempInfo : TGridInfo; begin DoRevert(BasicSettingsGrid,AdvancedSettingsGrid); { tempInfo := GetInfoForGrid(BasicSettingsGrid); LoadAnyGridFromInfo(tempInfo); tempInfo := GetInfoForGrid(AdvancedSettingsGrid); LoadAnyGridFromInfo(tempInfo); tempInfo.ApplyBtn.Enabled := false; tempInfo.RevertBtn.Enabled := false; } end; procedure TMainForm.DoRevert(BasicGrid,AdvancedGrid : TSortStringGrid); //BasicGrid doesn't have to be supplied. Can be nil value. //AdvancedGrid is required. var tempInfo : TGridInfo; begin tempInfo := GetInfoForGrid(AdvancedGrid); LoadAnyGridFromInfo(tempInfo); tempInfo.ApplyBtn.Enabled := false; tempInfo.RevertBtn.Enabled := false; if BasicGrid <> nil then begin tempInfo := GetInfoForGrid(BasicGrid); LoadAnyGridFromInfo(tempInfo); end; end; procedure TMainForm.btnSettingsApplyClick(Sender: TObject); begin PostVisibleGrid; end; end.