Ignore:
Timestamp:
Aug 12, 2009, 7:14:16 PM (15 years ago)
Author:
Kevin Toppenberg
Message:

TMG Ver 1.1 Added HTML Support, better demographics editing

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/fPtDemoEdit.pas

    r498 r541  
    66uses
    77  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    8   Dialogs, ComCtrls, StdCtrls, ExtCtrls, DKLang;
     8  Dialogs, ComCtrls, StdCtrls, ExtCtrls, DKLang, Grids;
    99
    1010type
    1111  BoolUC = (bucFalse, bucTrue, bucUnchanged);
    12  
     12
     13  tFileEntry = record
     14    Field     : string;
     15    FileNum   : string;
     16    FieldName : String;
     17    IENS      : string;
     18    oldValue,newValue : string;
     19  end;
     20
     21  TGridInfo = class;  //forward declaration
     22  TGridDataLoader = procedure (GridInfo: TGridInfo) of object;
     23  TGridInfo = class (TObject)
     24  public
     25    Grid      : TStringGrid;  //doesn't own object
     26    FileNum   : string;
     27    IENS      : string;
     28    BasicMode : Boolean;
     29    Data      : TStringList;  //doesn't own object
     30    Message   : string;  //optional text.
     31    DataLoadProc : TGridDataLoader;
     32    ApplyBtn  : TButton;
     33    RevertBtn : TButton;
     34  end;
     35
    1336  TPatientInfo = class(TObject)
    1437  public
    … …  
    5881
    5982    Modified : boolean;
    60      
     83
    6184    constructor Create;
    6285    destructor Destroy; override;
    … …  
    126149    DKLanguageController1: TDKLanguageController;
    127150    EMailEdit: TEdit;
     151    Advanced: TTabSheet;
     152    gridPatientDemo: TStringGrid;
    128153    procedure AliasComboBoxChange(Sender: TObject);
    129154    procedure FormCreate(Sender: TObject);
    … …  
    162187    procedure DOBEditChange(Sender: TObject);
    163188    procedure SSNumEditChange(Sender: TObject);
     189    procedure PageControlChange(Sender: TObject);
     190    procedure gridPatientDemoSelectCell(Sender: TObject; ACol,
     191      ARow: Integer; var CanSelect: Boolean);
     192    procedure gridPatientDemoSetEditText(Sender: TObject; ACol,
     193      ARow: Integer; const Value: String);
     194    procedure PageControlChanging(Sender: TObject;
     195      var AllowChange: Boolean);
    164196  private
    165197    { Private declarations }
    … …  
    167199    FServerPatientInfo : TPatientInfo;
    168200    FCurAliasEdit : integer;
     201    CurrentAnyFileData : TStringList;
    169202    ProgAliasChangeOccuring : boolean;
     203    CurrentPatientData : TStringList;
    170204    ProgNameChangeOccuring : boolean;
    171205    ProgPhoneChangeOccuring : boolean;
     206    FLastSelectedRow,FLastSelectedCol : integer;
    172207    ProgAddressChangeOccuring : boolean;
     208    DataForGrid : TStringList;
    173209    MaxAliasIEN : integer;
     210    Data : TStringList;
    174211    ChangesMade : boolean;
     212    BasicTemplate : TStringList;
     213    FLoadingGrid: boolean;
     214    CachedWPField : TStringList;
    175215    procedure GetPtInfo(PatientInfo : TPatientInfo);
    176216    procedure PostChangedInfo(PatientInfo : TPatientInfo);
    177217    procedure ShowAliasInfo(Patient : TPatientInfo);
     218    procedure GetPatientInfo(GridInfo: TGridInfo);
    178219    procedure ShowPtInfo(Patient : TPatientInfo);
    179220    function CombinedName : string;
     221    procedure AddGridInfo(Grid: TStringGrid;
     222                                  Data : TStringList;
     223                                  BasicMode : boolean;
     224                                  DataLoader : TGridDataLoader;
     225                                  FileNum : string);
    180226    procedure NameParts(CombinedName: string; var LName, FName, MName : string);
     227    function ExtractNum (S : String; StartPos : integer) : string;
    181228    procedure SetModified(value : boolean);
    182229    procedure SetAliasEnabled(value : boolean);
     230    function PostChanges(Grid : TStringGrid) : TModalResult;
     231    procedure CompileChanges(Grid : TStringGrid; CurrentUserData,Changes : TStringList);
     232    procedure RegisterGridInfo(GridInfo : TGridInfo);
    183233  public
    184234    { Public declarations }
     235    function GetInfoForGrid(Grid : TStringGrid) : TGridInfo;
     236    procedure LoadAnyGrid(Grid : TStringGrid; BasicMode: boolean; FileNum : string;
     237                                  IENS : string;
     238                                  CurrentData : TStringList);
     239    procedure LoadAnyGridFromInfo(GridInfo : TGridInfo);
     240    function IsWPField(FileNum,FieldNum : string) : boolean;
     241    function IsSubFile(FieldDef: string ; var SubFileNum : string) : boolean;
     242    function GetInfoIndexForGrid(Grid : TStringGrid) : integer;
     243    function PostVisibleGrid: TModalResult;
     244    function GetLineInfo(Grid : TStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry;
     245    procedure GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo: TStringList);
     246    //procedure GridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
     247    function GetUserLine(CurrentUserData : TStringList; Grid : TStringGrid; ARow: integer) : integer;
     248    function FindInStrings(fieldNum : string; Strings : TStringList; var fileNum : string) : integer;
    185249  end;
    186250
    … …  
    188252  frmPtDemoEdit: TfrmPtDemoEdit;
    189253
     254Const
     255  DEF_GRID_ROW_HEIGHT = 17; 
     256  CLICK_FOR_SUBS = '<CLICK for Sub-Entries>';
     257  COMPUTED_FIELD = '<Computed Field --> CAN''T EDIT>';
     258  CLICK_TO_EDIT = '<CLICK to Edit Text>';
     259  HIDDEN_FIELD = '<Hidden>';
     260
    190261implementation
    191262
    … …  
    193264
    194265uses
    195   IniFiles,Trpcb,ORNet,uCore, mfunstr, strutils;
     266  IniFiles,Trpcb,ORNet,uCore, mfunstr, subfilesU, strutils, LookupU, SetSelU,
     267  SelDateTimeU, PostU, EditTextU, FMErrorU;
    196268
    197269const
    … …  
    218290begin
    219291  AliasInfo := TStringList.Create;
     292 
    220293  Clear;
    221294end;
    … …  
    250323  DOB:= '';
    251324  SSNum:= '';
     325  EMail:= '';
    252326  ClearAliasInfo; 
    253327  AddressLine1:= '';
    … …  
    300374  DOB:=Source.DOB;
    301375  SSNum:=Source.SSNum;
     376  EMail:=Source.EMail;
    302377 
    303378  ClearAliasInfo;
    … …  
    424499  CompStrs(DOB, OldInfo.DOB);
    425500  CompStrs(SSNum, OldInfo.SSNum);
     501  CompStrs(EMail, OldInfo.EMail);
    426502 
    427503  CompStrs(AddressLine1, OldInfo.AddressLine1);
    … …  
    554630    Sex:= tempINI.ReadString('DATA','SEX','');
    555631    SSNum:= tempINI.ReadString('DATA','SS_NUM','');
     632    EMail:= tempINI.ReadString('DATA','EMAIL','');
    556633    AddressLine1:= tempINI.ReadString('DATA','ADDRESS_LINE_1','');
    557634    AddressLine2:= tempINI.ReadString('DATA','ADDRESS_LINE_2','');
    … …  
    621698    CheckPost('SEX',Sex);
    622699    CheckPost('SS_NUM',SSNum);
     700    CheckPost('EMAIL',EMail);
    623701    CheckPost('ADDRESS_LINE_1',AddressLine1);
    624702    CheckPost('ADDRESS_LINE_2',AddressLine2);
    … …  
    690768    DOBEdit.Text := DOB;
    691769    SSNumEdit.Text := SSNum;
     770    EMailEdit.Text := EMail;
    692771    if Sex='MALE' then SexComboBox.ItemIndex := 0 else SexComboBox.ItemIndex := 1;
    693772    AliasComboBox.Items.Clear;
    … …  
    748827    end; 
    749828    ShowAliasInfo(FCurPatientInfo);
    750   end; 
     829  end;
    751830end;
    752831
    … …  
    756835  FCurPatientInfo := TPatientInfo.Create;
    757836  FServerPatientInfo := TPatientInfo.Create;
     837  DataForGrid := TStringList.Create;  //will own GridInfo objects.
    758838  ProgAliasChangeOccuring  := false;
    759839  ProgNameChangeOccuring := false;
    … …  
    762842  MaxAliasIEN := 0;
    763843  ChangesMade := false;
     844  CurrentPatientData := TStringList.Create;
     845  AddGridInfo(GridPatientDemo,CurrentPatientData,false,GetPatientInfo,'2');
     846
    764847end;
    765848
    766849procedure TfrmPtDemoEdit.FormDestroy(Sender: TObject);
    767850begin
     851  DataForGrid.Free;
    768852  FCurPatientInfo.Destroy;
    769853  FServerPatientInfo.Destroy;
     854  CurrentPatientData.Free;
    770855end;
    771856
    … …  
    887972procedure TfrmPtDemoEdit.FormShow(Sender: TObject);
    888973begin
     974  PageControl.ActivePageIndex := 0;
    889975  GetPtInfo(FServerPatientInfo);
    890976  FCurPatientInfo.Assign(FServerPatientInfo);
    891   ShowPtInfo(FCurPatientInfo); 
     977  ShowPtInfo(FCurPatientInfo);
    892978end;
    893979
    … …  
    11781264var TempPatientInfo : tPatientInfo;
    11791265begin
     1266if pagecontrol.ActivePageIndex = 0 then begin
    11801267  TempPatientInfo := tPatientInfo.Create;
    11811268  TempPatientInfo.Assign(FCurPatientInfo);
    … …  
    11841271  TempPatientInfo.Destroy;
    11851272  SetModified(false);
    1186 end;
     1273end else begin
     1274  PostVisibleGrid;
     1275  SetModified(false);
     1276end;
     1277end;
     1278function TfrmPtDemoEdit.PostVisibleGrid: TModalResult;
     1279  begin
     1280    result := PostChanges(gridPatientDemo);
     1281  end;
     1282
     1283function TfrmPtDemoEdit.PostChanges(Grid : TStringGrid) : TModalResult;
     1284  //Results:  mrNone -- no post done (not needed)
     1285  //          mrCancel -- user pressed cancel on confirmation screen.
     1286  //          mrNo -- signals posting error.
     1287  var Changes : TStringList;
     1288      PostResult : TModalResult;
     1289      CurrentData : TStringList;
     1290      GridInfo : TGridInfo;
     1291      IENS : string; 
     1292  begin
     1293    Result := mrNone;  //default to No changes
     1294    GridInfo := GetInfoForGrid(Grid);
     1295    if GridInfo=nil then exit;
     1296    CurrentData := GridInfo.Data;
     1297    if CurrentData=nil then exit;
     1298    if CurrentData.Count = 0 then exit;
     1299    IENS := Patient.DFN;
     1300    if IENS='' then exit;
     1301    Changes := TStringList.Create;
     1302    CompileChanges(Grid,CurrentData,Changes);
     1303    if Changes.Count>0 then begin
     1304      PostForm.PrepForm(Changes);
     1305      PostResult := PostForm.ShowModal;
     1306      if PostResult = mrOK then begin
     1307        //if DisuserChanged(Changes) then begin  //looks for change in file 200, field 4
     1308        //  InitializeUsersTreeView;
     1309        //end else begin
     1310          if Pos('+',IENS)>0 then begin
     1311            GridInfo.IENS := PostForm.GetNewIENS(IENS);
     1312          end;
     1313          if assigned(GridInfo.DataLoadProc) then begin
     1314            GridInfo.DataLoadProc(GridInfo);
     1315          end;
     1316          {
     1317          if CurrentData = CurrentUserData then begin
     1318            LoadUserData(IENS,CurrentData);  //reload record from server.
     1319          end else if CurrentData = CurrentSettingsData then begin
     1320            GetSettingsInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
     1321          end else if CurrentData = CurrentPatientData then begin
     1322            GetPatientInfo(GridInfo.IENS, CurrentData);           
     1323          end else if CurrentData = CurrentAnyFileData then begin
     1324            GetAnyFileInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
     1325          end; 
     1326          }
     1327        //end; 
     1328      end else if PostResult = mrNo then begin  //mrNo is signal of post Error
     1329        // show error...
     1330      end;
     1331      Result := PostResult;
     1332    end else begin
     1333      Result := mrNone; 
     1334    end;
     1335    Changes.Free;
     1336  end;
     1337
     1338  procedure TfrmPtDemoEdit.CompileChanges(Grid : TStringGrid; CurrentUserData,Changes : TStringList);
     1339  //Output format:
     1340  // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
     1341
     1342  var row : integer;
     1343      Entry : tFileEntry;
     1344      oneEntry : string;
     1345  begin
     1346    for row := 1 to Grid.RowCount-1 do begin
     1347      Entry := GetLineInfo(Grid,CurrentUserData, row);
     1348      if Entry.oldValue <> Entry.newValue then begin
     1349        if (Entry.newValue <> CLICK_FOR_SUBS) and
     1350          (Entry.newValue <> COMPUTED_FIELD) and
     1351          (Entry.newValue <> CLICK_TO_EDIT) then begin   
     1352          oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName;
     1353          oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue;
     1354          Changes.Add(oneEntry);
     1355        end; 
     1356      end;
     1357    end;
     1358  end;
    11871359
    11881360procedure TfrmPtDemoEdit.SetModified(value : boolean);
    … …  
    12191391    case MessageDlg('Apply Changes?',mtConfirmation,mbYesNoCancel,0) of
    12201392      mrYes : begin
    1221                 ApplyBtnClick(Sender);   
    1222                 frmPtDemoEdit.ModalResult := mrOK;  //closes form                                       
     1393                ApplyBtnClick(Sender);
     1394                frmPtDemoEdit.ModalResult := mrOK;  //closes form
    12231395              end;
    12241396      mrNo : begin
    … …  
    12491421
    12501422
    1251 
     1423procedure TfrmPtDemoEdit.PageControlChange(Sender: TObject);
     1424var
     1425   GridInfo : TGridInfo;
     1426   IEN : longInt;
     1427   ModalResult : TModalResult;
     1428
     1429begin
     1430    if pagecontrol.ActivePageIndex = 0 then begin
     1431       GetPtInfo(FServerPatientInfo);
     1432       FCurPatientInfo.Assign(FServerPatientInfo);
     1433       ShowPtInfo(FCurPatientInfo);
     1434    end else begin
     1435       IEN := strtoint(patient.dfn);  //get info from selected patient
     1436       if IEN = 0 then exit;
     1437       GridInfo := GetInfoForGrid(gridPatientDemo);
     1438       if GridInfo = nil then exit;
     1439       GridInfo.IENS := IntToStr(IEN)+',';
     1440       GetPatientInfo(GridInfo);
     1441    end;
     1442
     1443end;
     1444
     1445procedure TfrmPtDemoEdit.GetPatientInfo(GridInfo: TGridInfo);
     1446
     1447var cmd,RPCResult : string;
     1448    IENS : String;
     1449    grid : TStringGrid;
     1450begin
     1451//    IENS := Patient.DFN;
     1452    IENS := GridInfo.IENS;
     1453//    Data := GridInfo.Data;
     1454    grid := GridInfo.Grid;
     1455    grid.Cells[0,1] := '';
     1456    grid.Cells[1,1] := '';
     1457    grid.Cells[2,1] := '';
     1458    grid.RowCount :=2;
     1459    grid.Cursor := crHourGlass;
     1460    if IENS <> '0,' then begin
     1461      RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
     1462      RPCBrokerV.param[0].ptype := list;
     1463      cmd := 'GET ONE RECORD^2^' + IENS;
     1464      RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
     1465      RPCBrokerV.Call;
     1466      RPCResult := RPCBrokerV.Results[0];    //returns:  error: -1;  success=1
     1467      //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
     1468      //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
     1469      if piece(RPCResult,'^',1)='-1' then begin
     1470        messagedlg(RPCBrokerV.Results[1],mtError,mbOKCancel,0);
     1471        //FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
     1472      end else begin
     1473        GridInfo.Data.Assign(RPCBrokerV.results);
     1474        //LoadAnyGrid(grid,false,'2',IENS,Data);
     1475        LoadAnyGridFromInfo(GridInfo);
     1476      end;
     1477    end;
     1478  gridPatientDemo.Cursor := crDefault;
     1479end;
     1480
     1481procedure TfrmPtDemoEdit.LoadAnyGrid(Grid : TStringGrid;  //the TStringGrid to load
     1482                                     BasicMode: boolean;
     1483                                     FileNum : string;
     1484                                     IENS : string;
     1485                                     CurrentData : TStringList);
     1486  var
     1487    GridInfo : TGridInfo;
     1488  begin
     1489    GridInfo := TGridInfo.Create;
     1490    //This stores load information into a GridInfo
     1491    GridInfo.Grid := Grid;
     1492    GridInfo.BasicMode := BasicMode;
     1493    GridInfo.FileNum := FileNum;
     1494    GridInfo.IENS := IENS;
     1495    GridInfo.Data := CurrentData;
     1496    LoadAnyGridFromInfo(GridInfo);
     1497    GridInfo.Free;
     1498  end;
     1499
     1500procedure TfrmPtDemoEdit.LoadAnyGridFromInfo(GridInfo : TGridInfo);
     1501  //This assumes that GridInfo already has loaded info.
     1502  var
     1503    Grid : TStringGrid;  //the TStringGrid to load
     1504    BasicMode: boolean;
     1505    FileNum : string;
     1506    IENS : string;
     1507    CurrentData : TStringList;
     1508
     1509    procedure LoadOneLine (Grid : TStringGrid; oneEntry : string; GridRow : integer);
     1510    var
     1511      tempFile,IENS : string;
     1512      fieldNum,fieldName,fieldDef : string;
     1513      subFileNum : string;
     1514      value : string;
     1515    begin
     1516      tempFile := Piece(oneEntry,'^',1);
     1517      if tempFile = FileNum then begin //handle subfiles later...
     1518        IENS := Piece(oneEntry,'^',2);
     1519        fieldNum := Piece(oneEntry,'^',3);
     1520        value := Piece(oneEntry,'^',4);
     1521        fieldName := Piece(oneEntry,'^',5);
     1522        fieldDef := Piece(oneEntry,'^',6);
     1523        Grid.RowCount := GridRow + 1;
     1524        Grid.Cells[0,GridRow] := fieldNum;
     1525        Grid.Cells[1,GridRow] := fieldName;
     1526        if Pos('W',fieldDef)>0 then begin
     1527          Grid.Cells[2,GridRow] := CLICK_TO_EDIT;
     1528        end else if IsSubFile(fieldDef, subFileNum) then begin
     1529          if IsWPField(FileNum,fieldNum) then begin
     1530            Grid.Cells[2,GridRow] := CLICK_TO_EDIT;
     1531          end else begin
     1532            Grid.Cells[2,GridRow] := CLICK_FOR_SUBS;
     1533          end;
     1534        end else if Pos('C',fieldDef)>0 then begin
     1535          Grid.Cells[2,GridRow] := COMPUTED_FIELD;
     1536        end else begin
     1537          Grid.Cells[2,GridRow] := value;
     1538        end;
     1539        Grid.RowHeights[GridRow] := DEF_GRID_ROW_HEIGHT;
     1540      end;
     1541    end;
     1542
     1543    function getOneLine(CurrentData : TStringList; oneFileNum,oneFieldNum : string) : string;
     1544    var i : integer;
     1545        FileNum,FieldNum : string;
     1546    begin
     1547      result := '';
     1548      // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
     1549      for i := 1 to CurrentData.Count - 1 do begin
     1550        FileNum := piece(CurrentData.Strings[i],'^',1);
     1551        if FileNum <> oneFileNum then continue;
     1552        FieldNum := piece(CurrentData.Strings[i],'^',3);
     1553        if FieldNum <> oneFieldNum then continue;
     1554        result := CurrentData.Strings[i];
     1555        break;
     1556      end;
     1557    end;
     1558
     1559  var i : integer;
     1560      oneEntry  : string;
     1561      oneFileNum,oneFieldNum : string;
     1562      gridRow : integer;
     1563
     1564  begin
     1565    FLoadingGrid := true;
     1566    if GridInfo=nil then exit;
     1567    Grid := GridInfo.Grid;
     1568    BasicMode := GridInfo.BasicMode;
     1569    FileNum := GridInfo.FileNum;
     1570    IENS := GridInfo.IENS;
     1571    CurrentData := GridInfo.Data;
     1572
     1573    Grid.Cells[0,1] := '';
     1574    Grid.Cells[1,1] := '';
     1575    Grid.Cells[2,1] := '';
     1576    Grid.RowCount :=2;
     1577    Grid.ColWidths[0] := 50;
     1578    Grid.ColWidths[1] := 200;
     1579    Grid.ColWidths[2] := 300;
     1580    Grid.Cells[0,0] := '#';
     1581    Grid.Cells[1,0] := 'Name';
     1582    Grid.Cells[2,0] := 'Value';
     1583
     1584    if BasicMode=false then begin
     1585      for i := 1 to CurrentData.Count-1 do begin  //start at 1 because [0] = 1^Success
     1586        oneEntry := CurrentData.Strings[i];
     1587        LoadOneLine (Grid,oneEntry,i);
     1588      end;
     1589    end else if BasicMode=true then begin
     1590      gridRow := 1;
     1591      for i := 0 to BasicTemplate.Count-1 do begin
     1592        oneFileNum := Piece(BasicTemplate.Strings[i],'^',1);
     1593        if oneFileNum <> fileNum then continue;
     1594        oneFieldNum := Piece(BasicTemplate.Strings[i],'^',2);
     1595        oneEntry := getOneLine(CurrentData,oneFileNum,oneFieldNum);
     1596        LoadOneLine (Grid,oneEntry,gridRow);
     1597        Inc(GridRow);
     1598      end;
     1599    end;
     1600    FLoadingGrid := false;
     1601  end;
     1602
     1603  function TfrmPtDemoEdit.GetInfoForGrid(Grid : TStringGrid) : TGridInfo;
     1604  var i : integer;
     1605  begin
     1606    i := GetInfoIndexForGrid(Grid);
     1607    if i > -1 then begin
     1608      result := TGridInfo(DataForGrid.Objects[i]);
     1609    end else begin
     1610      result := nil;
     1611    end;
     1612  end;
     1613
     1614
     1615  function TfrmPtDemoEdit.GetInfoIndexForGrid(Grid : TStringGrid) : integer;
     1616  var s : string;
     1617  begin
     1618    s := IntToStr(integer(Grid));
     1619    result := Dataforgrid.indexof(s);
     1620  end;
     1621
     1622function TfrmPtDemoEdit.IsSubFile(FieldDef: string ; var SubFileNum : string) : boolean;
     1623  //SubFileNum is OUT parameter
     1624  begin
     1625    SubFileNum := ExtractNum(FieldDef,1);
     1626    result := (SubFileNum <> '');
     1627  end;
     1628   
     1629  function TfrmPtDemoEdit.IsWPField(FileNum,FieldNum : string) : boolean;
     1630  var RPCResult : string;
     1631      SrchStr : string;
     1632      Idx: integer;
     1633  begin
     1634    SrchStr := FileNum + '^' +  FieldNum + '^';
     1635    //Idx := CachedWPField.IndexOf(SrchStr + 'YES');
     1636    //if Idx > -1 then begin Result := true; exit; end;
     1637    //Idx := CachedWPField.IndexOf(SrchStr + 'NO');
     1638    //if Idx > -1 then begin Result := false; exit; end;
     1639 
     1640    result := false;
     1641    RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
     1642    RPCBrokerV.param[0].ptype := list;
     1643    RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'IS WP FIELD^' + FileNum + '^' + FieldNum;
     1644    RPCBrokerV.Call;
     1645    RPCResult := RPCBrokerV.Results[0];    //returns:  error: -1;  success=1
     1646    if piece(RPCResult,'^',1)='-1' then begin
     1647      //FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
     1648      //FMErrorForm.PrepMessage;
     1649      //FMErrorForm.ShowModal;
     1650    end else begin
     1651      RPCResult := piece(RPCResult,'^',3);
     1652      result := (RPCResult = 'YES');
     1653      //CachedWPField.Add(SrchStr + RPCResult);
     1654    end;   
     1655  end;
     1656
     1657  function TfrmPtDemoEdit.ExtractNum (S : String; StartPos : integer) : string;
     1658  var i : integer;
     1659      ch : char;
     1660  begin
     1661    result := '';
     1662    if (S = '') or (StartPos < 0) then exit;
     1663    i := StartPos;
     1664    repeat
     1665      ch := S[i];
     1666      i := i + 1;
     1667      if ch in ['0'..'9','.'] then begin
     1668        Result := Result + ch;
     1669      end; 
     1670    until (i > length(S)) or not  (ch in ['0'..'9','.'])
     1671  end;
     1672
     1673  procedure TfrmPtDemoEdit.gridPatientDemoSelectCell(Sender: TObject; ACol,
     1674  ARow: Integer; var CanSelect: Boolean);
     1675    (*
     1676    For Field def, here is the legend
     1677    character     meaning
     1678
     1679    BC            The data is Boolean Computed (true or false).
     1680    C             The data is Computed.
     1681    Cm            The data is multiline Computed.
     1682    DC            The data is Date-valued, Computed.
     1683    D             The data is Date-valued.
     1684    F             The data is Free text.
     1685    I             The data is uneditable.
     1686    Pn            The data is a Pointer reference to file "n".
     1687    S             The data is from a discrete Set of codes.
     1688   
     1689    N             The data is Numeric-valued.
     1690   
     1691    Jn            To specify a print length of n characters.
     1692    Jn,d                To specify printing n characters with decimals.
     1693
     1694    V             The data is a Variable pointer.
     1695    W             The data is Word processing.
     1696    WL            The Word processing data is normally printed in Line mode (i.e., without word wrap).
     1697      *)
     1698  var oneEntry,FieldDef : string;                                     
     1699      date,time: string;
     1700      FileNum,FieldNum,SubFileNum : string;
     1701      GridFileNum : string;
     1702      UserLine : integer;
     1703      Grid : TStringGrid;
     1704      IEN : int64;
     1705      IENS : string;
     1706      CurrentData : TStringList;
     1707      GridInfo : TGridInfo;
     1708      SubFileForm : TSubFileForm;
     1709  begin
     1710    if FLoadingGrid then exit;  //prevent pseudo-clicks during loading...
     1711    Grid := (Sender as TStringGrid);
     1712    GridInfo := GetInfoForGrid(Grid);
     1713    if GridInfo=nil then exit;
     1714    GridFileNum := GridInfo.FileNum;
     1715    CanSelect := false;  //default to NOT selectable.
     1716    CurrentData := GridInfo.Data;
     1717    if CurrentData=nil then exit;
     1718    if CurrentData.Count = 0 then exit;
     1719    UserLine := GetUserLine(CurrentData,Grid,ARow);
     1720    if UserLine = -1 then exit;
     1721    oneEntry := CurrentData.Strings[UserLine];
     1722    FieldDef := Piece(oneEntry,'^',6);
     1723    if Pos('F',FieldDef)>0 then begin  //Free text
     1724      CanSelect := true;
     1725    end else if IsSubFile(FieldDef,SubFileNum) then begin  //Subfiles.
     1726      FileNum :=  Piece(oneEntry,'^',1);
     1727      FieldNum :=  Piece(oneEntry,'^',3);
     1728      if IsWPField(FileNum,FieldNum) then begin
     1729        IENS :=  Piece(oneEntry,'^',2);
     1730        EditTextForm.PrepForm(FileNum,FieldNum,IENS);
     1731        EditTextForm.ShowModal;
     1732      end else begin
     1733        //handle subfiles here
     1734        IENS := '';
     1735        if GridInfo.Message = MSG_SUB_FILE then begin  //used message from subfile Grid
     1736          IENS := GridInfo.IENS;
     1737        end; // else if LastSelTreeNode <> nil then begin  //this is one of the selction trees.
     1738          IEN := strtoint(Patient.DFN); //longInt(LastSelTreeNode.Data);
     1739          if IEN > 0 then IENS := InttoStr(IEN) + ',';
     1740        if GridInfo.Data = CurrentAnyFileData then begin
     1741          IEN := strtoint(patient.dfn);  //get info from selected record
     1742          if IEN > 0 then IENS := InttoStr(IEN) + ',';
     1743        end;
     1744        if IENS <> '' then begin
     1745          SubFileForm := TSubFileForm.Create(self);
     1746          SubFileForm.PrepForm(SubFileNum,IENS);
     1747          SubfileForm.ShowModal;  // note: may call this function again recursively for sub-sub-files etc.
     1748          SubFileForm.Free;
     1749        end else begin
     1750          MessageDlg('IENS for File="".  Can''t process.',mtInformation,[MBOK],0);
     1751        end;
     1752      end;
     1753    end else if Pos('C',FieldDef)>0 then begin  //computed fields.
     1754      CanSelect := false;
     1755    end else if Pos('D',FieldDef)>0 then begin  //date field
     1756      date := piece(Grid.Cells[ACol,ARow],'@',1);
     1757      time := piece(Grid.Cells[ACol,ARow],'@',2);
     1758      if date <> '' then begin
     1759        SelDateTimeForm.DateTimePicker.Date := StrToDate(date);
     1760      end else begin
     1761        SelDateTimeForm.DateTimePicker.Date := SysUtils.Date;
     1762      end;
     1763      if SelDateTimeForm.ShowModal = mrOK then begin
     1764        date := DateToStr(SelDateTimeForm.DateTimePicker.Date);
     1765        time := TimeToStr(SelDateTimeForm.DateTimePicker.Time);
     1766        if time <> '' then date := date; // + '@' + time;    elh 8/15/08
     1767        Grid.Cells[ACol,ARow] := date;
     1768      end;
     1769      CanSelect := true;
     1770    end else if Pos('S',FieldDef)>0 then begin  //Set of Codes
     1771      SetSelForm.PrepForm(Piece(oneEntry,'^',7));
     1772      if SetSelForm.ShowModal = mrOK then begin
     1773        Grid.Cells[ACol,ARow] := SetSelForm.ComboBox.Text;
     1774        CanSelect := true;
     1775      end;
     1776    end else if Pos('I',FieldDef)>0 then begin  //uneditable
     1777      ShowMessage('Sorry. Flagged as UNEDITABLE.');
     1778    end else if Pos('P',FieldDef)>0 then begin  //Pointer to file.
     1779      FileNum := ExtractNum (FieldDef,Pos('P',FieldDef)+1);
     1780      //check for validity here...
     1781      FieldLookupForm.PrepForm(FileNum,Grid.Cells[ACol,ARow]);
     1782      if FieldLookupForm.ShowModal = mrOK then begin
     1783        Grid.Cells[ACol,ARow] := FieldLookupForm.ORComboBox.Text;
     1784        CanSelect := true;
     1785      end;
     1786    end;
     1787    if CanSelect then begin
     1788      FLastSelectedRow := ARow;
     1789      FLastSelectedCol := ACol;
     1790      SetModified(True);
     1791    end;
     1792    //GridInfo.ApplyBtn.Enabled := true;
     1793    //GridInfo.RevertBtn.Enabled := true;
     1794  end;
     1795
     1796  function TfrmPtDemoEdit.GetLineInfo(Grid : TStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry;
     1797  var fieldNum : string;
     1798      oneEntry : string;
     1799      fileNum : string;
     1800      gridRow : integer;
     1801  begin
     1802    fieldNum := Grid.Cells[0,ARow];
     1803    gridRow := FindInStrings(fieldNum, CurrentUserData, fileNum);
     1804    if gridRow > -1 then begin
     1805      oneEntry := CurrentUserData.Strings[gridRow];
     1806      Result.Field := fieldNum;
     1807      Result.FieldName := Grid.Cells[1,ARow];
     1808      Result.FileNum := fileNum;
     1809      Result.IENS := Piece(oneEntry,'^',2);
     1810      Result.oldValue := Piece(oneEntry,'^',4);
     1811      Result.newValue := Grid.Cells[2,ARow];
     1812    end else begin
     1813      Result.Field := '';
     1814      Result.FieldName := '';
     1815      Result.FileNum := '';
     1816      Result.IENS := '';
     1817      Result.oldValue := '';
     1818      Result.newValue := '';
     1819    end;
     1820  end;
     1821
     1822procedure TfrmPtDemoEdit.GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo: TStringList);
     1823  var cmd,RPCResult : string;
     1824      i : integer;
     1825      oneEntry : string;
     1826  begin
     1827    Data.Clear;
     1828    if (IENS='') then exit;
     1829    if Pos('+',IENS)=0 then begin //don't ask server to load +1 records.
     1830      RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
     1831      RPCBrokerV.Param[0].Value := '.X';  // not used
     1832      RPCBrokerV.param[0].ptype := list;
     1833      cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS;
     1834      RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
     1835      RPCBrokerV.Call;
     1836      RPCResult := RPCBrokerV.Results[0];    //returns:  error: -1;  success=1
     1837      if piece(RPCResult,'^',1)='-1' then begin
     1838      FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
     1839      FMErrorForm.PrepMessage;
     1840      FMErrorForm.ShowModal;
     1841      end else begin
     1842        Data.Assign(RPCBrokerV.Results);
     1843      end;
     1844    end else begin
     1845      Data.Add('1^Success');  //to keep same as call to server
     1846      if BlankFileInfo.Count = 0 then begin
     1847        //Format is: FileNum^^FieldNum^^DDInfo...
     1848        //  elh GetBlankFileInfo(FileNum,BlankFileInfo);
     1849      end; 
     1850      for i := 1 to BlankFileInfo.Count-1 do begin  //0 is 1^success
     1851        oneEntry := BlankFileInfo.Strings[i];
     1852        //  elh SetPiece(oneEntry,'^',2,IENS);
     1853        Data.Add(oneEntry);
     1854      end;
     1855    end;
     1856  end;
     1857
     1858function TfrmPtDemoEdit.GetUserLine(CurrentUserData : TStringList; Grid : TStringGrid; ARow: integer) : integer;
     1859  var fieldNum: string;
     1860      tempFileNum : string;
     1861  begin
     1862    fieldNum := Grid.Cells[0,ARow];
     1863    Result := FindInStrings(fieldNum,CurrentUserData,tempFileNum);
     1864  end;
     1865
     1866  function TfrmPtDemoEdit.FindInStrings(fieldNum : string; Strings : TStringList; var fileNum : string) : integer;
     1867  //Note: if fileNum is passed blank, then first matching file will be placed in it (i.e. OUT parameter)
     1868  var tempFieldNum : string;
     1869      oneEntry,tempFile : string;
     1870      i : integer;
     1871  begin
     1872    result := -1;
     1873    fileNum := '';
     1874    for i := 1 to Strings.Count-1 do begin   //0 --> 1^success
     1875      oneEntry := Strings.Strings[i];
     1876      tempFile := Piece(oneEntry,'^',1);
     1877      if fileNum='' then fileNum := tempFile;
     1878      if tempFile <> fileNum then continue; //ignore subfiles
     1879      tempFieldNum := Piece(oneEntry,'^',3);
     1880      if tempFieldNum <> fieldNum then continue;
     1881      Result := i;
     1882      break;
     1883    end;
     1884  end;
     1885
     1886 procedure TfrmPtDemoEdit.AddGridInfo(Grid: TStringGrid;
     1887                                  Data : TStringList;
     1888                                  BasicMode : boolean;
     1889                                  DataLoader : TGridDataLoader;
     1890                                  FileNum : string);
     1891  var tempGridInfo : TGridInfo;
     1892  begin
     1893    tempGridInfo := TGridInfo.Create;
     1894    tempGridInfo.Grid := Grid;
     1895    tempGridInfo.Data := Data;
     1896    tempGridInfo.BasicMode := BasicMode;
     1897    tempGridInfo.FileNum := FileNum;
     1898    tempGridInfo.DataLoadProc := DataLoader;
     1899    //tempGridInfo.ApplyBtn := ApplyBtn;
     1900    //tempGridInfo.RevertBtn := RevertBtn;
     1901    RegisterGridInfo(tempGridInfo);
     1902  end;
     1903
     1904procedure TfrmPtDemoEdit.RegisterGridInfo(GridInfo : TGridInfo);
     1905  var s : string;
     1906  begin
     1907    if GridInfo = nil then exit;
     1908    s := IntToStr(integer(GridInfo.Grid));
     1909    DataForGrid.AddObject(s,GridInfo);
     1910  end;
     1911
     1912procedure TfrmPtDemoEdit.gridPatientDemoSetEditText(Sender: TObject; ACol,
     1913                                            ARow: Integer; const Value: String);
     1914begin
     1915  SetModified(True);
     1916end;
     1917
     1918procedure TfrmPtDemoEdit.PageControlChanging(Sender: TObject;
     1919  var AllowChange: Boolean);
     1920var
     1921   intAnswer : Integer;
     1922begin
     1923//Before changing the form, find out if changes need to be applied and
     1924//prompt user.            elh
     1925    if ApplyBtn.enabled = True then begin
     1926       intAnswer := messagedlg('Do you want to apply your changes?', mtWarning,mbYesNoCancel,0);
     1927       if intAnswer = mrYes then begin  //Yes
     1928          ApplyBtnClick(Sender);
     1929          //messagedlg('Changes Saved.', mtWarning,[mbOK],0);
     1930          SetModified(False);
     1931        end else if intAnswer = mrNo then begin    //No
     1932          SetModified(False);
     1933        end else if intAnswer = mrCancel then begin    //Cancel
     1934          AllowChange := False;
     1935        end;
     1936    end;
     1937end;
    12521938end.
Note: See TracChangeset for help on using the changeset viewer.