| [459] | 1 | unit uOrPtf;   //PRF
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | interface
 | 
|---|
 | 4 | 
 | 
|---|
 | 5 | uses SysUtils, Windows, Classes, Forms, ORFn, ORNet, uCore;
 | 
|---|
 | 6 | 
 | 
|---|
 | 7 | Type
 | 
|---|
 | 8 |   TPatientFlag = Class(TObject)
 | 
|---|
 | 9 |   private
 | 
|---|
 | 10 |     FFlagID:   string;
 | 
|---|
 | 11 |     FName: string;
 | 
|---|
 | 12 |     FNarr: TStringList;
 | 
|---|
 | 13 |     FFlagIndex: integer;
 | 
|---|
 | 14 |   public
 | 
|---|
 | 15 |     property FlagID: string      read FFlagID  write FFlagID;
 | 
|---|
 | 16 |     property Name:   string      read FName    write FName;
 | 
|---|
 | 17 |     property Narr:   TStringList read FNarr    write FNarr;
 | 
|---|
 | 18 |     property FlagIndex: integer  read FFlagIndex write FFlagIndex;
 | 
|---|
 | 19 |     constructor Create;
 | 
|---|
 | 20 |     procedure Clearup;
 | 
|---|
 | 21 |   end;
 | 
|---|
 | 22 | 
 | 
|---|
 | 23 | procedure HasActiveFlg(var FlagList: TStringList; var HasFlag: boolean; const PTDFN: string);
 | 
|---|
| [460] | 24 | function TriggerPRFPopUp(PTDFN: String): boolean;
 | 
|---|
| [459] | 25 | procedure GetActiveFlg(FlagInfo: TStrings; const PTDFN, FlagRecordID: string);
 | 
|---|
 | 26 | procedure ClearFlag;
 | 
|---|
 | 27 | 
 | 
|---|
 | 28 | implementation
 | 
|---|
 | 29 | 
 | 
|---|
 | 30 | procedure HasActiveFlg(var FlagList: TStringList; var HasFlag: boolean; const PTDFN: string);
 | 
|---|
 | 31 | begin
 | 
|---|
 | 32 |   FlagList.Clear;
 | 
|---|
 | 33 |   HasFlag := False;
 | 
|---|
 | 34 |   CallV('ORPRF HASFLG',[PTDFN]);
 | 
|---|
 | 35 |   if RPCBrokerV.Results.Count > 0 then
 | 
|---|
 | 36 |   begin
 | 
|---|
 | 37 |     FlagList.Assign(RPCBrokerV.Results);
 | 
|---|
 | 38 |     HasFlag := True;
 | 
|---|
 | 39 |   end;
 | 
|---|
 | 40 | end;
 | 
|---|
 | 41 | 
 | 
|---|
| [460] | 42 | function TriggerPRFPopUp(PTDFN: String): boolean;
 | 
|---|
| [459] | 43 | begin
 | 
|---|
| [460] | 44 |   CallV('ORPRF TRIGGER POPUP',[PTDFN]);
 | 
|---|
 | 45 |   Result := RPCBrokerV.Results[0] = '1';
 | 
|---|
| [459] | 46 |   RPCBrokerV.Results.Delete(0);
 | 
|---|
 | 47 | end;
 | 
|---|
 | 48 | 
 | 
|---|
 | 49 | procedure TPatientFlag.Clearup;
 | 
|---|
 | 50 | begin
 | 
|---|
 | 51 |   FFlagID := '0';
 | 
|---|
 | 52 |   FName   := '';
 | 
|---|
 | 53 |   FNarr.Clear;
 | 
|---|
 | 54 |   FFlagIndex := -1;
 | 
|---|
 | 55 | end;
 | 
|---|
 | 56 | 
 | 
|---|
 | 57 | constructor TPatientFlag.Create;
 | 
|---|
 | 58 | begin
 | 
|---|
 | 59 |   FFlagID   := '0';
 | 
|---|
 | 60 |   FName := '';
 | 
|---|
 | 61 |   FNarr := TStringList.Create;
 | 
|---|
 | 62 |   FFlagIndex := -1;
 | 
|---|
 | 63 | end;
 | 
|---|
 | 64 | 
 | 
|---|
 | 65 | procedure GetActiveFlg(FlagInfo: TStrings; const PTDFN, FlagRecordID: string);
 | 
|---|
 | 66 | begin
 | 
|---|
 | 67 |   CallV('ORPRF GETFLG', [PTDFN,FlagRecordID]);
 | 
|---|
 | 68 |   if RPCBrokerV.Results.Count > 0 then
 | 
|---|
 | 69 |     FlagInfo.Assign(RPCBrokerV.Results);
 | 
|---|
 | 70 | end;
 | 
|---|
 | 71 | 
 | 
|---|
 | 72 | procedure ClearFlag;
 | 
|---|
 | 73 | begin
 | 
|---|
 | 74 |   sCallV('ORPRF CLEAR',[nil]);
 | 
|---|
 | 75 | end;
 | 
|---|
 | 76 | 
 | 
|---|
 | 77 | end.
 | 
|---|