{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          PPMS Medical DETAILS                        ***
 ***                                                                      ***
 *** M Hill                                                      Nov 1992 ***
 ****************************************************************************}
{$I compdirs}  {Compiler directives}

unit KPPMedcl;

INTERFACE

uses global, objects, scodes, views, kmore, output, inpflds;

const
 TMedicalSize = 350;        {GUESSED}

type
 PMedical = ^TMedical;
 TMedical = object(TMoreItem)

	 GP        : longint;
	 Doc       : array[1..3] of longint;
	 InsScheme : TSCode;
	 InsNo     : string[20];

	 {-- Methods --}
	 constructor INit(Param : pointer);
	 procedure CommonInit; virtual;
	 function DisplayLine(Maxlen : integer) : string; virtual;
	 procedure StartEditBox(var EditBox : PEditBox; Caller : PView); virtual;
	 function PrintSummary(Output : POutputStream) : word; virtual;

	 {DataBase}
	 constructor Load(var S : TStream);
	 procedure   Store(var S : TSTream);              virtual;

 end;

function CreateMedical(P : pointer) : pointer;

const
	{--- Required for Stream ----}
	RMedical : TStreamRec = (
		ObjType : srMedical;
		VmtLink : Ofs(TypeOf(TMedical)^);
		Load : @TMedical.Load;
		Store : @TMedical.Store
	);


IMPLEMENTATION

uses inpdnt, inpdir, kdirctry, dialogs, files, estrings;

{**************************************************************
 ***                                                        ***
 ***               DEFINE Medical OBJECT                     ***
 ***                                                        ***
 **************************************************************}

 constructor TMedical.Init;
 begin
	 inherited INit(Param);
	 CommonInit;
	 GP := -1; Doc[1] := -1; Doc[2] := -1; Doc[3] := -1;
 end;

 procedure TMedical.CommonInit;
 {Basically makes sure they are open, and opens them if not}
 begin
	 SCodeAdmin[scinsurance]^.LogOn;
 end;

 {==== CREATE DISPLAY-LINE-FORMAT STRING ============}
 function TMedical.DisplayLine(maxlen : integer) : string;
 var S : string;
		 GPPerson : PDirectoryItem;

 begin
	 DirectoryStreamLogOn;
	 if GP>-1 then begin
		 GPPerson := PDirectoryItem(DirectoryStream^.GetAtID(GP, lkIgnore));
		 S := GPPerson^.GetName(naDisplay, 0);
		 Dispose(GPPerson, done);
   end else
     S := 'None';
	 DirectoryStreamLogOff;

   DisplayLine := 'MEDICAL: '
								+UCase(SCodeAdmin[scInsurance]^.Collection^.Desc(InsScheme))
                + ', GP '+ S;
 end;

{*****************************************
 ***        SCREEN INPUT BOX           ***
 *****************************************}

procedure TMedical.StartEditBox;
var	R: TRect;

begin
	R.Assign(0, 0, 42, 14);
	New(EditBox, init(R, 'Medical Admin'));

	inherited StartEditBox(EditBox, Caller);

	with EditBox^ do begin
		InsTitle( 9, 2,30, 'GP', R);     Insert(New(PInputDirectory, Init(R,30, ipStandard, ixDirectory)));
		InsTitle( 9, 3,30, 'Others', R); Insert(New(PInputDirectory, Init(R,30, ipStandard, ixDirectory)));
		InsTitle( 9, 4,30, '', R);       Insert(New(PInputDirectory, Init(R,30, ipStandard, ixDirectory)));
		InsTitle( 9, 5,30, '', R);       Insert(New(PInputDirectory, Init(R,30, ipStandard, ixDirectory)));

		InsTitle(11, 7, 0, 'Insurance', R);
		InsTitle( 9, 8,30, 'Scheme',    R); Insert(New(PInputSCode, init(R, scInsurance)));
		InsTitle( 9, 9,20, 'No',        R); Insert(New(PInputELine, init(R, 20)));

		{-- Buttons --}
		InsButton(14,11, 8, '~O~K',      cmOK,      bfDefault);
		InsButton(25,11, 8, '~C~ancel',  cmCancel,  bfNormal);
	end;
end;

{*****************************************
 ***        PRINT SUMMARY              ***
 *****************************************}
function TMedical.PrintSummary;
var Person1,Person2 : PDirectoryItem;
		S : string;

begin
	Output^.Writeln('MEDICAL:');
	DirectoryStreamLogOn;

	Person1 := nil; Person2 := nil;
	if GP>-1 		 then Person1 := PDirectoryItem(DirectoryStream^.GetAtID(GP,     lkIgnore));
	if Doc[1]>-1 then Person2 := PDirectoryItem(DirectoryStream^.GetAtID(Doc[1], lkIgnore));
	if Person1 <>nil then S := 'GP: '+Person1^.GetName(naSurFull, 0);
	if Person2 <>nil then S := PadSpaceR(S,40) + Person2^.GetName(naSurFull, 0);
	Output^.Writeln(S);
	Output^.Writeln('');

	If Person1 <>nil then begin dispose(Person1, done); person1 := nil; end;
	if person2 <>nil then begin dispose(person2, done); person2 := nil; end;

	if Doc[2]>-1 then Person1 := PDirectoryItem(DirectoryStream^.GetAtID(Doc[2], lkIgnore));
	if Doc[3]>-1 then Person2 := PDirectoryItem(DirectoryStream^.GetAtID(Doc[3], lkIgnore));
	if Person1 <>nil then S := '    '+Person1^.GetName(naSurFull, 0);
	if Person2 <>nil then S := PadSpaceR(S,40) + Person2^.GetName(naSurFull, 0);
	Output^.writeln(S);
	Output^.Writeln('');

	If Person1 <>nil then begin dispose(Person1, done); person1 := nil; end;
	if person2 <>nil then begin dispose(person2, done); person2 := nil; end;

	DirectoryStreamLogOff;
	Output^.Writeln('INSURANCE SCHEME: '+SCodeAdmin[scInsurance]^.Collection^.Desc(InsScheme));
	Output^.Writeln('              NO: '+InsNo);
end;


{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}
constructor TMedical.Load(var S : TStream);
var Ver : byte;
		Rubbish : longint;

begin
  S.Read(Ver, 1);
  if Ver = 1 then begin

    S.Read(GP, 4);
    S.Read(Doc[1], 4);
    S.Read(Doc[2], 4);
    S.Read(Doc[3], 4);
    S.Read(InsScheme, sizeof(InsScheme));
		S.Read(InsNo, sizeof(InsNo));

		S.Read(Rubbish, 4);

    inherited Load(S);
  end;

	CommonInit;
end;

procedure TMedical.Store(var S : TStream);
var I : integer;
    StartPos : longint;
    Ver : byte;
		Rubbish : longint;

begin
	StartPos := S.GetPos;
	Ver := 1; S.Write(ver ,1);

	S.Write(GP, 4);
	S.Write(Doc[1], 4);
	S.Write(Doc[2], 4);
	S.Write(Doc[3], 4);
	S.Write(InsScheme, sizeof(InsScheme));
	S.Write(InsNo, sizeof(InsNo));

	S.Write(Rubbish, 4); {Saves changing version... old ptr2cha}

	inherited Store(S);

	TopUpRecord(S, TMedicalSize, StartPos);
end;

function CreateMedical;
begin	CreateMedical := New(PMedical, Init(P)); end;


{**********************************
 ***         MORE GLOBALS       ***
 **********************************}
begin
	{Register Various sentence codes}
	New(SCodeAdmin[scInsurance], Init('KInsuran.SC', 'Insurance', CreateSCodeItem));

	RegisterType(RMedical); {Register for streams}

{$IFDEF kppmedcl}{$IFNDEF solitaire}   {For solitair, just allow display - not new}
	{Register existence in sr list  - used by chain viewers}
	NewMoreItem('~M~edical',cmNewMedical, CreateMedical);
{$ENDIF}{$ENDIF}
end.
