{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          M E D I C A L                               ***
 ***                                                                      ***
 *** M Hill                                                      FEB 1996 ***
 ****************************************************************************}
{$I compdirs}  {Compiler directives}

unit KMedical;

INTERFACE

uses jimmys,
			dattime,
			files,
			scodes,
			global,
			tuiedit, views,
			devices, forms;

{****************************************
 ***        Medical                   ***
 ****************************************}
type
	PMedical = ^TMedical;
	TMedical = object(TJimmy)
		ForWho 		: longint;
		ForEvent 	: longint; {for crush/consultation/etc}
		Date 			: TDate;

		SymptomsCode : string[11];
		SymptomsNote : string[30];
		DiagnosisCode : string[11];
		DiagnosisNote : string[30];

		Treatment : array[1..4] of record
			Code : TSCode;
			Note : string[20];
		end;

		OutcomeDate : TDate;
		OutcomeCode : string[11];
		OutcomeNote : string[30];

		{-- Methods --}
		constructor Init(Param : PJimmyInitParam);
		procedure CommonInit; virtual;
		destructor Done; virtual;

		{Display/edit/print}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{DataBase}
		function RecSize : word; virtual;
		function srType : word; virtual;

		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream);              virtual;

		{-- Hooking to others -----}
		function NumHookTo : byte; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint; var hkType : byte; var Key : longint); virtual;
	end;

IMPLEMENTATION

uses
			objects,
			tui,
{$IFDEF klivestk} app, inpjimmy, tuilist, {$ENDIF} {for selecting "for who"}
			kdirctry,{}
			kamsetup,
			tasks,
			inpjimmy,
			tuijimmy,
			tuimsgs,
			minilib,
			inpdnt;

{****************************************************************
 ***                                                          ***
 ***                MEDICAL DETAILS                             ***
 ***                                                          ***
 ****************************************************************}

{--- Inititalise - set ptrs to SC ---}
constructor TMedical.Init;
begin
	inherited Init;
	if DeadDataMode then Date.Clear else Date.SetToToday;
	OutcomeDate.Clear;
	ForWho := -1;
	ForEvent := -1;

	if Param<>nil then begin
		ForWho := Param^.ForWho;
		if ForWho = -1 then begin
			ForWho := Param^.FocusedParentID;
			ForEvent:= Param^.FocusedID;
		end;
	end;
end;

procedure TMedical.CommonInit;
begin
	inherited CommonInit;
	ScodeCollection[scSymptoms]^.LogOn;
	ScodeCollection[scDiagnosis]^.LogOn;
	ScodeCollection[scTreatment]^.LogOn;
	ScodeCollection[scOutcomes]^.LogOn;
end;

destructor TMedical.Done;
begin
	ScodeCollection[scSymptoms]^.LogOff;
	ScodeCollection[scDiagnosis]^.LogOff;
	ScodeCollection[scTreatment]^.LogOff;
	ScodeCollection[scOutcomes]^.LogOff;
	inherited Done;
end;

 {==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function TMedical.DisplayLine;
var S : string;
		B : byte;
begin
	{First line}
	S := Date.Digit8+' ';
	if delspaceR(SymptomsCode+SymptomsNote)<>'' then S := S + ExpandSCode(scSymptoms, SymptomsCode)+' '+SymptomsNote+#13+space(9);
	if delspaceR(DiagnosisCode+DiagnosisNote)<>'' then
			S := S + ExpandSCode(scDiagnosis, DiagnosisCode)+' '+DiagnosisNote+#13+space(9);
	for B := 1 to 4 do
		if delspaceR(Treatment[b].Code+Treatment[B].Note)<>'' then
			S := S + ExpandSCode(scTreatment, Treatment[B].Code)+' '+Treatment[B].Note+#13+space(9);

	if delspaceR(OutcomeCode+OutcomeNote)<>'' then
		S := S + ExpandSCode(scOutcomes, OutcomeCode)+' '+OutcomeNote+#13+space(9);

	if Right(S, 10)=#13+space(9) then S := Copy(S,1,length(S)-10); {remove  extra indent}

	DisplayLine := S;
end;


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

procedure TMedical.MakeEditBox;
var	R: TRect;
		I : longint;
		S : String;
		DateLine, SymLine : PView;

begin
	R.Assign(0, 0, 55, 21);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Medical Details',Caller, @Self));

	with EditBox^ do begin
		Insert(new(PSkipBytes, init(sizeof(TJimmy))));{}

{$IFDEF klivestk}
		InsTitledField(12, 1,30, 1, '~F~or', New(PInputINdexedJImmy, init(R, 25, fiLiveStockIdx, lsLiveStock, '')));
{$ELSE}
		InsTitledField(12, 1,30, 1, '~F~or', New(PInputDirectory, init(R, 25, fiFullDirIdx, lsDIrectory, '')));
{$ENDIF}

		R.XYLD(12, 2,30, 1); Insert(New(PInputJimmy, init(R, 25, 0)));
{$IFDEF klivestk}	AddLabel('Crush', Current); {$ELSE} AddLabel('Event',Current); {$ENDIF}
		Current^.SetState(sfDisabled, True);

		DateLine := InsTitledField(12, 3,10, 1, 'D~a~te', New(PinputDate, Init(R)));

		SymLine := InsTitledField(12, 5,30, 1, '~S~ymptoms', New(PInputSCLine, init(R,11,scSymptoms)));
		InsTitledField(12, 6,30, 1, '',				New(PInputELine, init(R,30)));

		InsTitledField(12, 8,30, 1, '~D~iagnosis', New(PInputSCLine, init(R,11,scDiagnosis)));
		InsTitledField(12, 9,30, 1, '',				New(PInputELine, init(R,30)));

		S := '~T~reatment';
		for I := 1 to 4 do begin
			InsTitledField(12, 10+I,18, 1, S, 	New(PInputSCode, init(R,scTreatment)));
			InsTitledField(34, 10+I,16, 1, '',	New(PInputELine, init(R,20)));
			S := '';
		end;

		InsTitledField(12, 16,10,1, 'O~u~tcome', New(PInputDate, init(R)));
		InsTitledField(12, 17,30, 1, '', New(PInputSCLine, init(R,11,scOutcomes)));
		InsTitledField(12, 18,30, 1, '',				New(PInputELine, init(R,30)));

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init( 		44,Size.Y-5, @Self)));
		Insert(New(PJimmyCancelButton, init(44,Size.Y-3, @Self)));

		EndInit;
	end;

	if ForWho<>-1 then
		if Date.Blank then DateLine^.Focus else SymLine^.Focus;
end;


{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

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

function TMedical.RecSize : word;
begin RecSize:= 300; end;

function TMedical.srType : word;
begin srType := srMedical; end;

constructor TMedical.Load(var S : TDataStream);
var	Ver : byte;
		I : byte;

begin
	S.Read(Ver, 1);

	case Ver of
		1 : begin
			{pre v4.2}
			CommonInit;
			S.Read(LockTerminal,1);
			S.Read(ForWho, 4);
			ForEvent := -1;
			Date.Load(S);
			SymptomsCode := S.ReadStr;
			SymptomsNote := S.ReadStr;
			DiagnosisCode := S.ReadStr;
			DiagnosisNote := S.ReadStr;
			for I := 1 to 4 do begin
				Treatment[i].Code := S.ReadFixedStr(3);
				Treatment[I].Note := S.ReadStr;
			end;
			OutcomeDate.Load(S);
			OutcomeCode := S.ReadStr;
			OutcomeNote := S.ReadStr;
		end;
		2 : begin
			inherited Load(S);
			S.Read(ForWho, 4);
			S.Read(ForEvent, 4);
			Date.Load(S);
			SymptomsCode := S.ReadStr;
			SymptomsNote := S.ReadStr;
			DiagnosisCode := S.ReadStr;
			DiagnosisNote := S.ReadStr;
			for I := 1 to 4 do begin
				Treatment[i].Code := S.ReadFixedStr(3);
				Treatment[I].Note := S.ReadStr;
			end;
			OutcomeDate.Load(S);
			OutcomeCode := S.ReadStr;
			OutcomeNote := S.ReadStr;
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'Medical.Load',mfError);
		fail;
	end;
end;

procedure TMedical.StoreFields(var S : TDataStream);
var	I : byte;
		Ver : byte;

begin
	Ver := 2; S.Write(Ver, 1);

	inherited StoreFields(S);

	S.Write(FOrWho, 4);
	S.Write(ForEvent, 4);
	Date.Store(S);

	S.writeStr(@SymptomsCode);
	S.WriteStr(@SymptomsNote);
	S.writeStr(@DiagnosisCode);
	S.WriteStr(@DiagnosisNote);
	for I := 1 to 4 do begin
		S.writeFixedStr(@Treatment[I].Code, 3);
		S.WriteStr(@Treatment[I].Note);
	end;
	OutcomeDate.Store(S);
	S.writeStr(@OutcomeCode);
	S.WriteStr(@OutcomeNote);
end;

function TMedical.NumHookTo;
begin NumHooKTo := 1; end;

procedure TMedical.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID, SubHookToID, hkType, Key);

	if Date.Blank then
		Key := SortKeyStart                 {Make sure appears at beginning}
	else
		Key := -Date.Days;  {Reverse Sort on date}

	case htType of
		1 : begin HookToID := @ForWho; SubHookToID := @ForEvent; hkType := hkHistory; end;
	end;
end;


{********************************************
 ***             SET FORM CODES           ***
 ********************************************}
procedure TMedical.SetFormCodes;
var S : string;
begin
	with FormCodes^ do begin
		SetDate('DT', Date);
	end;
end;


{********************************************
 ***             PRINT                    ***
 ********************************************}


{*****************************************
 ***         CREATORS                  ***
 *****************************************}

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


begin
{$IFDEF fixit} writeln('Medical...'); {$ENDIF}
	New(ScodeCollection[scSymptoms], init('SYMPTOMS.SC', 'Medical Symptoms', StdSCodeCreator));
	New(ScodeCollection[scDiagnosis], init('DIAGNOS.SC', 'Medical Diagnosis', StdSCodeCreator));
	New(ScodeCollection[scTreatment], init('TREATMNT.SC', 'Medical Treatment', StdSCodeCreator));
	New(ScodeCollection[scOutcomes], init('OUTCOME.SC', 'Medical Outcome', StdSCodeCreator));

	RegisterType(RMedical);

{$IFDEF klivestk}
	RegisterNewWithList(lsLivestockHistory, '~M~edical', cmNewMedical);
	RegisterCreator(cmNewMedical, CreateMedical);
{$ENDIF}
end.
