Context Navigation

uPCE.pas@ 1806

Last change on this file since 1806 was 460, checked in by Kevin Toppenberg, 16 years ago
Uploading from OR_30_258
File size: 109.2 KB

Rev	Line
[459]	1	unit uPCE;
	2
	3	interface
	4
	5	uses Windows, SysUtils, Classes, ORFn, uConst, ORCtrls, ORClasses,UBAGlobals;
	6
	7	type
	8	TPCEProviderRec = record
	9	IEN: int64;
	10	Name: string;
	11	Primary: boolean;
	12	Delete: boolean;
	13	end;
	14
	15	TPCEProviderList = class(TORStringList)
	16	private
	17	FNoUpdate: boolean;
	18	FOnPrimaryChanged: TNotifyEvent;
	19	FPendingDefault: string;
	20	FPendingUser: string;
	21	FPCEProviderIEN: Int64;
	22	FPCEProviderName: string;
	23	function GetProviderData(Index: integer): TPCEProviderRec;
	24	procedure SetProviderData(Index: integer; const Value: TPCEProviderRec);
	25	function GetPrimaryIdx: integer;
	26	procedure SetPrimaryIdx(const Value: integer);
	27	procedure SetPrimary(index: integer; Primary: boolean);
	28	public
	29	function Add(const S: string): Integer; override;
	30	function AddProvider(AIEN, AName: string; APrimary: boolean): integer;
	31	procedure Assign(Source: TPersistent); override;
	32	function PCEProvider: Int64;
	33	function PCEProviderName: string;
	34	function IndexOfProvider(AIEN: string): integer;
	35	procedure Merge(AList: TPCEProviderList);
	36	procedure Clear; override;
	37	procedure Delete(Index: Integer); override;
	38	function PrimaryIEN: int64;
	39	function PrimaryName: string;
	40	function PendingIEN(ADefault: boolean): Int64;
	41	function PendingName(ADefault: boolean): string;
	42	property ProviderData[Index: integer]: TPCEProviderRec read GetProviderData
	43	write SetProviderData; default;
	44	property PrimaryIdx: integer read GetPrimaryIdx write SetPrimaryIdx;
	45	property OnPrimaryChanged: TNotifyEvent read FOnPrimaryChanged
	46	write FOnPrimaryChanged;
	47	end;
	48
	49	TPCEItem = class(TObject)
	50	{base class for PCE items}
	51	private
	52	FDelete: Boolean; //flag for deletion
	53	FSend: Boolean; //flag to send to broker
	54	FComment: String;
	55	protected
	56	procedure SetComment(const Value: String);
	57	public
	58	// Provider: Int64;
	59	Provider: Int64;
	60	Code: string;
	61	Category: string;
	62	Narrative: string;
	63	FGecRem: string;
	64	procedure Assign(Src: TPCEItem); virtual;
	65	procedure Clear; virtual;
	66	function DelimitedStr: string; virtual;
	67	function DelimitedStr2: string; virtual;
	68	function ItemStr: string; virtual;
	69	function Match(AnItem: TPCEItem): Boolean;
	70	// function MatchProvider(AnItem: TPCEItem):Boolean;
	71	function MatchProvider(AnItem: TPCEItem):Boolean;
	72	procedure SetFromString(const x: string); virtual;
	73	function HasCPTStr: string; virtual;
	74	property Comment: String read FComment write SetComment;
	75	property GecRem: string read FGecRem write FGecRem;
	76	end;
	77
	78	TPCEItemClass = class of TPCEItem;
	79
	80	TPCEProc = class(TPCEItem)
	81	{class for procedures}
	82	public
	83	FIsOldProcedure: boolean;
	84	Quantity: Integer;
	85	Modifiers: string; // Format Modifier1IEN;Modifier2IEN;Modifier3IEN; Trailing ; needed
	86	// Provider: Int64; {jm 9/8/99}
	87	Provider: Int64; {jm 9/8/99}
	88	procedure Assign(Src: TPCEItem); override;
	89	procedure Clear; override;
	90	function DelimitedStr: string; override;
	91	// function DelimitedStrC: string;
	92	// function Match(AnItem: TPCEProc): Boolean;
	93	function ModText: string;
	94	function ItemStr: string; override;
	95	procedure SetFromString(const x: string); override;
	96	procedure CopyProc(Dest: TPCEProc);
	97	function Empty: boolean;
	98	end;
	99
	100	TPCEDiag = class(TPCEItem)
	101	{class for diagnosis}
	102	public
	103	fProvider: Int64;
	104	Primary: Boolean;
	105	AddProb: Boolean;
	106	OldComment: string;
	107	SaveComment: boolean;
	108	procedure Assign(Src: TPCEItem); override;
	109	procedure Clear; override;
	110	function DelimitedStr: string; override;
	111	function DelimitedStr2: string; override;
	112	// function delimitedStrC: string;
	113	function ItemStr: string; override;
	114	procedure SetFromString(const x: string); override;
	115	procedure Send;
	116	end;
	117
	118	TPCEExams = class(TPCEItem)
	119	{class for Examinations}
	120	public
	121	// Provider: Int64;
	122	Results: String;
	123	procedure Assign(Src: TPCEItem); override;
	124	procedure Clear; override;
	125	function DelimitedStr: string; override;
	126	// function delimitedStrC: string;
	127	function ItemStr: string; override;
	128	procedure SetFromString(const x: string); override;
	129	function HasCPTStr: string; override;
	130	end;
	131
	132
	133	TPCEHealth = class(TPCEItem)
	134	{class for Health Factors}
	135	public
	136	// Provider: Int64; {jm 9/8/99}
	137	Level: string;
	138	procedure Assign(Src: TPCEItem); override;
	139	procedure Clear; override;
	140	function DelimitedStr: string; override;
	141	// function delimitedStrC: string;
	142	function ItemStr: string; override;
	143	procedure SetFromString(const x: string); override;
	144	function HasCPTStr: string; override;
	145	end;
	146
	147	TPCEImm = class(TPCEItem)
	148	{class for immunizations}
	149	public
	150	// Provider: Int64; {jm 9/8/99}
	151	Series: String;
	152	Reaction: String;
	153	Refused: Boolean; //not currently used
	154	Contraindicated: Boolean;
	155	procedure Assign(Src: TPCEItem); override;
	156	procedure Clear; override;
	157	function DelimitedStr: string; override;
	158	// function delimitedStrC: string;
	159	function ItemStr: string; override;
	160	procedure SetFromString(const x: string); override;
	161	function HasCPTStr: string; override;
	162	end;
	163
	164	TPCEPat = class(TPCEItem)
	165	{class for patient Education}
	166	public
	167	// Provider: Int64; {jm 9/8/99}
	168	Level: String;
	169	procedure Assign(Src: TPCEItem); override;
	170	procedure Clear; override;
	171	function DelimitedStr: string; override;
	172	// function delimitedStrC: string;
	173	function ItemStr: string; override;
	174	procedure SetFromString(const x: string); override;
	175	function HasCPTStr: string; override;
	176	end;
	177
	178	TPCESkin = class(TPCEItem)
	179	{class for skin tests}
	180	public
	181	// Provider: Int64; {jm 9/8/99}
	182	Results: String; //Do not confuse for reserved word "result"
	183	Reading: Integer;
	184	DTRead: TFMDateTime;
	185	DTGiven: TFMDateTime;
	186	procedure Assign(Src: TPCEItem); override;
	187	procedure Clear; override;
	188	function DelimitedStr: string; override;
	189	// function delimitedStrC: string;
	190	function ItemStr: string; override;
	191	procedure SetFromString(const x: string); override;
	192	function HasCPTStr: string; override;
	193	end;
	194
	195	// TPCEData = class;
	196
	197	tRequiredPCEDataType = (ndDiag, ndProc, ndSC); {jm 9/9/99}
	198	tRequiredPCEDataTypes = set of tRequiredPCEDataType;
	199
	200	//modified: 6/9/99
	201	//By: Robert Bott
	202	//Location: ISL
	203	//Purpose: Changed to allow capture of multiple providers.
	204	TPCEData = class
	205	{class for data to be passed to and from broker}
	206	private
	207	FUpdated: boolean;
	208	FEncDateTime: TFMDateTime; //encounter date & time
	209	FNoteDateTime: TFMDateTime; //Note date & time
	210	FEncLocation: Integer; //encounter location
	211	FEncSvcCat: Char; //
	212	FEncInpatient: Boolean; //Inpatient flag
	213	FEncUseCurr: Boolean; //
	214	FSCChanged: Boolean; //
	215	FSCRelated: Integer; //service con. related?
	216	FAORelated: Integer; //
	217	FIRRelated: Integer; //
	218	FECRelated: Integer; //
	219	FMSTRelated: Integer; //
	220	FHNCRelated: Integer; //
	221	FCVRelated: Integer; //
	222	FVisitType: TPCEProc; //
	223	FProviders: TPCEProviderList;
	224	FDiagnoses: TList; //pointer list for diagnosis
	225	FProcedures: TList; //pointer list for Procedures
	226	FImmunizations: TList; //pointer list for Immunizations
	227	FSkinTests: TList; //pointer list for skin tests
	228	FPatientEds: TList;
	229	FHealthFactors: TList;
	230	fExams: TList;
	231	FNoteTitle: Integer;
	232	FNoteIEN: Integer;
	233	FParent: string; // Parent Visit for secondary encounters
	234	FHistoricalLocation: string; // Institution IEN^Name (if IEN=0 Piece 4 = outside location)
	235	FStandAlone: boolean;
	236	FStandAloneLoaded: boolean;
	237
	238	function GetVisitString: string;
	239	function GetCPTRequired: Boolean;
	240	function getDocCount: Integer;
	241	function MatchItem(AList: TList; AnItem: TPCEItem): Integer;
	242	procedure MarkDeletions(PreList: TList; PostList: TStrings);
	243	procedure SetSCRelated(Value: Integer);
	244	procedure SetAORelated(Value: Integer);
	245	procedure SetIRRelated(Value: Integer);
	246	procedure SetECRelated(Value: Integer);
	247	procedure SetMSTRelated(Value: Integer);
	248	procedure SetHNCRelated(Value: Integer);
	249	procedure SetCVRelated(Value: Integer);
	250	procedure SetEncUseCurr(Value: Boolean);
	251	function GetHasData: Boolean;
	252	procedure GetHasCPTList(AList: TStrings);
	253	procedure CopyPCEItems(Src: TList; Dest: TObject; ItemClass: TPCEItemClass);
	254	public
	255	constructor Create;
	256	destructor Destroy; override;
	257	procedure Clear;
	258	procedure CopyPCEData(Dest: TPCEData);
	259	function Empty: boolean;
	260	procedure PCEForNote(NoteIEN: Integer; EditObj: TPCEData);(* overload;
	261	procedure PCEForNote(NoteIEN: Integer; EditObj: TPCEData; DCSummAdmitString: string); overload;*)
	262	procedure Save;
	263	procedure CopyDiagnoses(Dest: TStrings); // ICDcode^P\|S^Category^Narrative^P\|S Text
	264	procedure CopyProcedures(Dest: TStrings); // CPTcode^Qty^Category^Narrative^Qty Text
	265	procedure CopyImmunizations(Dest: TStrings); //
	266	procedure CopySkinTests(Dest: TStrings); //
	267	procedure CopyPatientEds(Dest: TStrings);
	268	procedure CopyHealthFactors(Dest: TStrings);
	269	procedure CopyExams(Dest: TStrings);
	270
	271	procedure SetDiagnoses(Src: TStrings; FromForm: boolean = TRUE); // ICDcode^P\|S^Category^Narrative^P\|S Text
	272	procedure SetExams(Src: TStrings; FromForm: boolean = TRUE);
	273	Procedure SetHealthFactors(Src: TStrings; FromForm: boolean = TRUE);
	274	procedure SetImmunizations(Src: TStrings; FromForm: boolean = TRUE); // IMMcode^
	275	Procedure SetPatientEds(Src: TStrings; FromForm: boolean = TRUE);
	276	procedure SetSkinTests(Src: TStrings; FromForm: boolean = TRUE); //
	277	procedure SetProcedures(Src: TStrings; FromForm: boolean = TRUE); // CPTcode^Qty^Category^Narrative^Qty Text
	278
	279	procedure SetVisitType(Value: TPCEProc); // CPTcode^1^Category^Narrative
	280	function StrDiagnoses: string; // Diagnoses: ...
	281	function StrImmunizations: string; // Immunizzations: ...
	282	function StrProcedures: string; // Procedures: ...
	283	function StrSkinTests: string;
	284	function StrPatientEds: string;
	285	function StrHealthFactors: string;
	286	function StrExams: string;
	287	function StrVisitType(const ASCRelated, AAORelated, AIRRelated, AECRelated,
	288	AMSTRelated, AHNCRelated, ACVRelated: Integer): string; overload;
	289	function StrVisitType: string; overload;
	290	function StandAlone: boolean;
	291	procedure AddStrData(List: TStrings);
	292	procedure AddVitalData(Data, List: TStrings);
	293
	294	function NeededPCEData: tRequiredPCEDataTypes;
	295	function OK2SignNote: boolean;
	296
	297	function PersonClassDate: TFMDateTime;
	298	function VisitDateTime: TFMDateTime;
	299	function IsSecondaryVisit: boolean;
	300	function NeedProviderInfo: boolean;
	301
	302	property HasData: Boolean read GetHasData;
	303	property CPTRequired: Boolean read GetCPTRequired;
	304	property Inpatient: Boolean read FEncInpatient;
	305	property UseEncounter: Boolean read FEncUseCurr write SetEncUseCurr;
	306	property SCRelated: Integer read FSCRelated write SetSCRelated;
	307	property AORelated: Integer read FAORelated write SetAORelated;
	308	property IRRelated: Integer read FIRRelated write SetIRRelated;
	309	property ECRelated: Integer read FECRelated write SetECRelated;
	310	property MSTRelated: Integer read FMSTRelated write SetMSTRelated;
	311	property HNCRelated: Integer read FHNCRelated write SetHNCRelated;
	312	property CVRelated: Integer read FCVRelated write SetCVRelated;
	313	property VisitType: TPCEProc read FVisitType write SetVisitType;
	314	property VisitString: string read GetVisitString;
	315	property VisitCategory:char read FEncSvcCat write FEncSvcCat;
	316	property DateTime: TFMDateTime read FEncDateTime write FEncDateTime;
	317	property NoteDateTime: TFMDateTime read FNoteDateTime write FNoteDateTime;
	318	property Location: Integer Read FencLocation;
	319	property NoteTitle: Integer read FNoteTitle write FNoteTitle;
	320	property NoteIEN: Integer read FNoteIEN write FNoteIEN;
	321	property DocCOunt: Integer read GetDocCount;
	322	property Providers: TPCEProviderList read FProviders;
	323	property Parent: string read FParent write FParent;
	324	property HistoricalLocation: string read FHistoricalLocation write FHistoricalLocation;
	325	property Updated: boolean read FUpdated write FUpdated;
	326	end;
	327
	328	type
	329	TPCEType = (ptEncounter, ptReminder, ptTemplate);
	330
	331	const
	332	PCETypeText: array[TPCEType] of string = ('encounter', 'reminder', 'template');
	333
	334	function InvalidPCEProviderTxt(AIEN: Int64; ADate: TFMDateTime): string;
	335	function MissingProviderInfo(PCEEdit: TPCEData; PCEType: TPCEType = ptEncounter): boolean;
	336	function IsOK2Sign(const PCEData: TPCEData; const IEN: integer) :boolean;
	337	function FutureEncounter(APCEData: TPCEData): boolean;
	338	function CanEditPCE(APCEData: TPCEData): boolean;
	339	procedure GetPCECodes(List: TStrings; CodeType: integer);
	340	procedure GetComboBoxMinMax(dest: TORComboBox; var Min, Max: integer);
	341	procedure PCELoadORCombo(dest: TORComboBox); overload;
	342	procedure PCELoadORCombo(dest: TORComboBox; var Min, Max: integer); overload;
	343	function GetPCEDisplayText(ID: string; Tag: integer): string;
	344	procedure SetDefaultProvider(ProviderList: TPCEProviderList; APCEData: TPCEData);
	345	function ValidateGAFDate(var GafDate: TFMDateTime): string;
	346	procedure GetVitalsFromDate(VitalStr: TStrings; PCEObj: TPCEData);
	347	procedure GetVitalsFromNote(VitalStr: TStrings; PCEObj: TPCEData; ANoteIEN: Int64);
	348
	349	type
	350	TPCEDataCat = (pdcVisit, pdcDiag, pdcProc, pdcImm, pdcSkin, pdcPED, pdcHF,
	351	pdcExam, pdcVital, pdcOrder, pdcMH, pdcMST, pdcHNC, pdcWHR, pdcWH);
	352
	353	function GetPCEDataText(Cat: TPCEDataCat; Code, Category, Narrative: string;
	354	PrimaryDiag: boolean = FALSE; Qty: integer = 0): string;
	355
	356	const
	357	PCEDataCatText: array[TPCEDataCat] of string =
	358	{ dcVisit } ('',
	359	{ dcDiag } 'Diagnoses: ',
	360	{ dcProc } 'Procedures: ',
	361	{ dcImm } 'Immunizations: ',
	362	{ dcSkin } 'Skin Tests: ',
	363	{ dcPED } 'Patient Educations: ',
	364	{ dcHF } 'Health Factors: ',
	365	{ dcExam } 'Examinations: ',
	366	{ dcVital } '',
	367	{ dcOrder } 'Orders: ',
	368	{ dcMH } 'Mental Health: ',
	369	{ dcMST } 'MST History: ',
	370	{ dcHNC } 'Head and/or Neck Cancer: ',
	371	{ dcWHR } 'Women''s Health Procedure: ',
	372	{ dcWH } 'WH Notification: ');
	373
	374	NoPCEValue = '@';
	375	TAB_STOP_CHARS = 7;
	376	TX_NO_VISIT = 'Insufficient Visit Information';
	377	TX_NEED_PROV1 = 'The provider responsible for this encounter must be entered before ';
	378	TX_NEED_PROV2 = ' information may be entered.';
	379	// TX_NEED_PROV3 = 'you can sign the note.';
	380	TX_NO_PROV = 'Missing Provider';
	381	TX_BAD_PROV = 'Invalid Provider';
	382	TX_NOT_ACTIVE = ' does not have an active person class.';
	383	TX_NOT_PROV = ' is not a known Provider.';
	384	TX_MISSING = 'Required Information Missing';
	385	TX_REQ1 = 'The following required fields have not been entered:' + CRLF;
	386	TC_REQ = 'Required Fields';
	387	TX_ADDEND_AD = 'Cannot make an addendum to an addendum' + CRLF +
	388	'Please select the parent note or document, and try again.';
	389	TX_ADDEND_MK = 'Unable to Make Addendum';
	390	TX_DEL_CNF = 'Confirm Deletion';
	391	TX_IN_AUTH = 'Insufficient Authorization';
	392	TX_NOPCE = '<No encounter information entered>';
	393	TX_NEED_T = 'Missing Encounter Information';
	394	TX_NEED1 = 'This note title is marked to prompt for the following missing' + CRLF +
	395	'encounter information:' + CRLF;
	396	TX_NEED_DIAG = ' A diagnosis.';
	397	TX_NEED_PROC = ' A visit type or procedure.';
	398	TX_NEED_SC = ' One or more service connected questions.';
	399	TX_NEED2 = 'Would you like to enter encounter information now?';
	400	TX_NEED3 = 'You must enter the encounter information before you can sign the note.';
	401	TX_NEEDABORT = 'Document not signed.';
	402	TX_COS_REQ = 'A cosigner is required for this document.';
	403	TX_COS_SELF = 'You cannot make yourself a cosigner.';
	404	TX_COS_AUTH = ' is not authorized to cosign this document.';
	405	TC_COS = 'Select Cosigner';
	406
	407	TAG_IMMSERIES = 10;
	408	TAG_IMMREACTION= 20;
	409	TAG_SKRESULTS = 30;
	410	TAG_PEDLEVEL = 40;
	411	TAG_HFLEVEL = 50;
	412	TAG_XAMRESULTS = 60;
	413	TAG_HISTLOC = 70;
	414
	415	{ These piece numbers are used by both the PCE objects and reminders }
	416	pnumCode = 2;
	417	pnumPrvdrIEN = 2;
	418	pnumCategory = 3;
	419	pnumNarrative = 4;
	420	pnumExamResults = 5;
	421	pnumSkinResults = 5;
	422	pnumHFLevel = 5;
	423	pnumImmSeries = 5;
	424	pnumProcQty = 5;
	425	pnumPEDLevel = 5;
	426	pnumDiagPrimary = 5;
	427	pnumPrvdrName = 5;
	428	pnumProvider = 6;
	429	pnumPrvdrPrimary = 6;
	430	pnumSkinReading = 7;
	431	pnumImmReaction = 7;
	432	pnumDiagAdd2PL = 7;
	433	pnumSkinDTRead = 8;
	434	pnumImmContra = 8;
	435	pnumSkinDTGiven = 9;
	436	pnumImmRefused = 9;
	437	pnumCPTMods = 9;
	438	pnumComment = 10;
	439	pnumWHPapResult =11;
	440	pnumWHNotPurp =12;
	441
	442	USE_CURRENT_VISITSTR = -2;
	443
	444	implementation
	445
	446	uses uCore, rPCE, rCore, rTIU, fEncounterFrame, uVitals, fFrame,
	447	fPCEProvider, rVitals, uReminders;
	448
	449	const
	450	FN_NEW_PERSON = 200;
	451
	452	function InvalidPCEProviderTxt(AIEN: Int64; ADate: TFMDateTime): string;
	453	begin
	454	Result := '';
	455	if(not CheckActivePerson(IntToStr(AIEN), ADate)) then
	456	Result := TX_NOT_ACTIVE
	457	else
	458	if(not IsUserAProvider(AIEN, ADate)) then
	459	Result := TX_NOT_PROV;
	460	end;
	461
	462	function MissingProviderInfo(PCEEdit: TPCEData; PCEType: TPCEType = ptEncounter): boolean;
	463	begin
	464	if(PCEEdit.Empty and (PCEEdit.Location <> Encounter.Location) and (not Encounter.NeedVisit)) then
	465	PCEEdit.UseEncounter := TRUE;
	466	Result := NoPrimaryPCEProvider(PCEEdit.Providers, PCEEdit);
	467	if(Result) then
	468	InfoBox(TX_NEED_PROV1 + PCETypeText[PCEType] + TX_NEED_PROV2,
	469	TX_NO_PROV, MB_OK or MB_ICONWARNING);
	470	end;
	471
	472	var
	473	UNxtCommSeqNum: integer;
	474
	475	function IsOK2Sign(const PCEData: TPCEData; const IEN: integer) :boolean;
	476	var
	477	TmpPCEData: TPCEData;
	478
	479	begin
	480	if(assigned(PCEData)) then
	481	PCEData.FUpdated := FALSE;
	482	if(assigned(PCEData) and (PCEData.VisitString <> '') and
	483	(VisitStrForNote(IEN) = PCEData.VisitString)) then
	484	begin
	485	if(PCEData.FNoteIEN <= 0) then
	486	PCEData.FNoteIEN := IEN;
	487	Result := PCEData.OK2SignNote
	488	end
	489	else
	490	begin
	491	TmpPCEData := TPCEData.Create;
	492	try
	493	TmpPCEData.PCEForNote(IEN, nil);
	494	Result := TmpPCEData.OK2SignNote;
	495	finally
	496	TmpPCEData.Free;
	497	end;
	498	end;
	499	end;
	500
	501	function FutureEncounter(APCEData: TPCEData): boolean;
	502	begin
	503	Result := (Int(APCEData.FEncDateTime + 0.0000001) > Int(FMToday + 0.0000001));
	504	end;
	505
	506	function CanEditPCE(APCEData: TPCEData): boolean;
	507	begin
	508	if(GetAskPCE(APCEData.FEncLocation) = apDisable) then
	509	Result := FALSE
	510	else
	511	Result := (not FutureEncounter(APCEData));
	512	end;
	513
	514	procedure GetComboBoxMinMax(dest: TORComboBox; var Min, Max: integer);
	515	var
	516	DC: HDC;
	517	SaveFont: HFont;
	518	TextSize: TSize;
	519	TLen, i: integer;
	520	x: string;
	521
	522	begin
	523	Min := MaxInt;
	524	Max := 0;
	525	DC := GetDC(0);
	526	try
	527	SaveFont := SelectObject(DC, dest.Font.Handle);
	528	try
	529	for i := 0 to dest.Items.Count-1 do
	530	begin
	531	x := dest.DisplayText[i];
	532	GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
	533	TLen := TextSize.cx;
	534	if(TLen > 0) and (Min > TLen) then
	535	Min := TLen;
	536	if(Max < TLen) then
	537	Max := TLen;
	538	end;
	539	finally
	540	SelectObject(DC, SaveFont);
	541	end;
	542	finally
	543	ReleaseDC(0, DC);
	544	end;
	545	if(Min > Max) then Min := Max;
	546
	547	inc(Min, ScrollBarWidth + 8);
	548	inc(Max, ScrollBarWidth + 8);
	549	end;
	550
	551	type
	552	TListMinMax = (mmMin, mmMax, mmFont);
	553
	554	var
	555	PCESetsOfCodes: TStringList = nil;
	556	HistLocations: TORStringList = nil;
	557	WHNotPurpose: TORStringList = nil;
	558	WHPapResult: TORStringList = nil;
	559	WHMammResult: TORStringList = nil;
	560	WHUltraResult: TORStringList = nil;
	561	const
	562	SetOfCodesHeader = '{^~Codes~^}';
	563	SOCHeaderLen = length(SetOfCodesHeader);
	564	ListMinMax: array[1..7, TListMinMax] of integer =
	565	((0,0,-1), // TAG_IMMSERIES
	566	(0,0,-1), // TAG_IMMREACTION
	567	(0,0,-1), // TAG_SKRESULTS
	568	(0,0,-1), // TAG_PEDLEVEL
	569	(0,0,-1), // TAG_HFLEVEL
	570	(0,0,-1), // TAG_XAMRESULTS
	571	(0,0,-1)); // TAG_HISTLOC
	572
	573	function CodeSetIndex(CodeType: integer): integer;
	574	var
	575	TempSL: TStringList;
	576	Hdr: string;
	577
	578	begin
	579	Hdr := SetOfCodesHeader + IntToStr(CodeType);
	580	Result := PCESetsOfCodes.IndexOf(Hdr);
	581	if(Result < 0) then
	582	begin
	583	TempSL := TStringList.Create;
	584	try
	585	case CodeType of
	586	TAG_IMMSERIES: LoadImmSeriesItems(TempSL);
	587	TAG_IMMREACTION: LoadImmReactionItems(TempSL);
	588	TAG_SKRESULTS: LoadSkResultsItems(TempSL);
	589	TAG_PEDLEVEL: LoadPEDLevelItems(TempSL);
	590	TAG_HFLEVEL: LoadHFLevelItems(TempSL);
	591	TAG_XAMRESULTS: LoadXAMResultsItems(TempSL);
	592	else
	593	KillObj(@TempSL);
	594	end;
	595	if(assigned(TempSL)) then
	596	begin
	597	Result := PCESetsOfCodes.Add(Hdr);
	598	PCESetsOfCodes.AddStrings(TempSL);
	599	end;
	600	finally
	601	KillObj(@TempSL);
	602	end;
	603	end;
	604	end;
	605
	606	procedure GetPCECodes(List: TStrings; CodeType: integer);
	607	var
	608	idx: integer;
	609
	610	begin
	611	if(CodeType = TAG_HISTLOC) then
	612	begin
	613	if(not assigned(HistLocations)) then
	614	begin
	615	HistLocations := TORStringList.Create;
	616	LoadHistLocations(HistLocations);
	617	HistLocations.SortByPiece(2);
	618	HistLocations.Insert(0,'0');
	619	end;
	620	List.AddStrings(HistLocations);
	621	end
	622	else
	623	begin
	624	if(not assigned(PCESetsOfCodes)) then
	625	PCESetsOfCodes := TStringList.Create;
	626	idx := CodeSetIndex(CodeType);
	627	if(idx >= 0) then
	628	begin
	629	inc(idx);
	630	while((idx < PCESetsOfCodes.Count) and
	631	(copy(PCESetsOfCodes[idx],1,SOCHeaderLen) <> SetOfCodesHeader)) do
	632	begin
	633	List.Add(PCESetsOfCodes[idx]);
	634	inc(idx);
	635	end;
	636	end;
	637	end;
	638	end;
	639
	640	function GetPCECodeString(CodeType: integer; ID: string): string;
	641	var
	642	idx: integer;
	643
	644	begin
	645	Result := '';
	646	if(CodeType <> TAG_HISTLOC) then
	647	begin
	648	if(not assigned(PCESetsOfCodes)) then
	649	PCESetsOfCodes := TStringList.Create;
	650	idx := CodeSetIndex(CodeType);
	651	if(idx >= 0) then
	652	begin
	653	inc(idx);
	654	while((idx < PCESetsOfCodes.Count) and
	655	(copy(PCESetsOfCodes[idx],1,SOCHeaderLen) <> SetOfCodesHeader)) do
	656	begin
	657	if(Piece(PCESetsOfCodes[idx], U, 1) = ID) then
	658	begin
	659	Result := Piece(PCESetsOfCodes[idx], U, 2);
	660	break;
	661	end;
	662	inc(idx);
	663	end;
	664	end;
	665	end;
	666	end;
	667
	668	procedure PCELoadORComboData(dest: TORComboBox; GetMinMax: boolean; var Min, Max: integer);
	669	var
	670	idx: integer;
	671
	672	begin
	673	if(dest.items.count < 1) then
	674	begin
	675	dest.Clear;
	676	GetPCECodes(dest.Items, dest.Tag);
	677	dest.itemindex := 0;
	678	if(GetMinMax) and (dest.Items.Count > 0) then
	679	begin
	680	idx := dest.Tag div 10;
	681	if(idx > 0) and (idx < 8) then
	682	begin
	683	if(ListMinMax[idx, mmFont] <> integer(dest.Font.Handle)) then
	684	begin
	685	GetComboBoxMinMax(dest, Min, Max);
	686	ListMinMax[idx, mmMin] := Min;
	687	ListMinMax[idx, mmMax] := Max;
	688	end
	689	else
	690	begin
	691	Min := ListMinMax[idx, mmMin];
	692	Max := ListMinMax[idx, mmMax];
	693	end;
	694	end;
	695	end;
	696	end;
	697	end;
	698
	699	procedure PCELoadORCombo(dest: TORComboBox);
	700	var
	701	tmp: integer;
	702
	703	begin
	704	PCELoadORComboData(dest, FALSE, tmp, tmp);
	705	end;
	706
	707	procedure PCELoadORCombo(dest: TORComboBox; var Min, Max: integer);
	708	begin
	709	PCELoadORComboData(dest, TRUE, Min, Max);
	710	end;
	711
	712	function GetPCEDisplayText(ID: string; Tag: integer): string;
	713	var
	714	Hdr: string;
	715	idx: integer;
	716	TempSL: TStringList;
	717
	718	begin
	719	Result := '';
	720	if(Tag = TAG_HISTLOC) then
	721	begin
	722	if(not assigned(HistLocations)) then
	723	begin
	724	HistLocations := TORStringList.Create;
	725	LoadHistLocations(HistLocations);
	726	HistLocations.SortByPiece(2);
	727	HistLocations.Insert(0,'0');
	728	end;
	729	idx := HistLocations.IndexOfPiece(ID);
	730	if(idx >= 0) then
	731	Result := Piece(HistLocations[idx], U, 2);
	732	end
	733	else
	734	begin
	735	if(not assigned(PCESetsOfCodes)) then
	736	PCESetsOfCodes := TStringList.Create;
	737	Hdr := SetOfCodesHeader + IntToStr(Tag);
	738	idx := PCESetsOfCodes.IndexOf(Hdr);
	739	if(idx < 0) then
	740	begin
	741	TempSL := TStringList.Create;
	742	try
	743	case Tag of
	744	TAG_IMMSERIES: LoadImmSeriesItems(TempSL);
	745	TAG_IMMREACTION: LoadImmReactionItems(TempSL);
	746	TAG_SKRESULTS: LoadSkResultsItems(TempSL);
	747	TAG_PEDLEVEL: LoadPEDLevelItems(TempSL);
	748	TAG_HFLEVEL: LoadHFLevelItems(TempSL);
	749	TAG_XAMRESULTS: LoadXAMResultsItems(TempSL);
	750	else
	751	KillObj(@TempSL);
	752	end;
	753	if(assigned(TempSL)) then
	754	begin
	755	idx := PCESetsOfCodes.Add(Hdr);
	756	PCESetsOfCodes.AddStrings(TempSL);
	757	end;
	758	finally
	759	KillObj(@TempSL);
	760	end;
	761	end;
	762	if(idx >= 0) then
	763	begin
	764	inc(idx);
	765	while((idx < PCESetsOfCodes.Count) and
	766	(copy(PCESetsOfCodes[idx],1,SOCHeaderLen) <> SetOfCodesHeader)) do
	767	begin
	768	if(Piece(PCESetsOfCodes[idx], U, 1) = ID) then
	769	begin
	770	Result := Piece(PCESetsOfCodes[idx], U, 2);
	771	break;
	772	end;
	773	inc(idx);
	774	end;
	775	end;
	776	end;
	777	end;
	778
	779	function GetPCEDataText(Cat: TPCEDataCat; Code, Category, Narrative: string;
	780	PrimaryDiag: boolean = FALSE; Qty: integer = 0): string;
	781	begin
	782	Result := '';
	783	case Cat of
	784	pdcVisit: if Code <> '' then Result := Category + ' ' + Narrative;
	785	pdcDiag: begin
	786	Result := Narrative;
	787	if PrimaryDiag then Result := Result + ' (Primary)';
	788	end;
	789	pdcProc: begin
	790	Result := Narrative;
	791	if Qty > 1 then Result := Result + ' (' + IntToStr(Qty) + ' times)';
	792	end;
	793	else Result := Narrative;
	794	end;
	795	end;
	796
	797	procedure SetDefaultProvider(ProviderList: TPCEProviderList; APCEData: TPCEData);
	798	var
	799	SIEN, tmp: string;
	800	DefUser, AUser: Int64;
	801	UserName: string;
	802
	803	begin
	804	DefUser := Encounter.Provider;
	805	if(DefUser <> 0) and (InvalidPCEProviderTxt(DefUser, APCEData.PersonClassDate) <> '') then
	806	DefUser := 0;
	807	if(DefUser <> 0) then
	808	begin
	809	AUser := DefUser;
	810	UserName := Encounter.ProviderName;
	811	end
	812	else
	813	if(InvalidPCEProviderTxt(User.DUZ, APCEData.PersonClassDate) = '') then
	814	begin
	815	AUser := User.DUZ;
	816	UserName := User.Name;
	817	end
	818	else
	819	begin
	820	AUser := 0;
	821	UserName := '';
	822	end;
	823	if(AUser = 0) then
	824	ProviderList.FPendingUser := ''
	825	else
	826	ProviderList.FPendingUser := IntToStr(AUser) + U + UserName;
	827	ProviderList.FPendingDefault := '';
	828	tmp := DefaultProvider(APCEData.Location, DefUser, APCEData.PersonClassDate, APCEData.NoteIEN);
	829	SIEN := IntToStr(StrToIntDef(Piece(tmp,U,1),0));
	830	if(SIEN <> '0') then
	831	begin
	832	if(CheckActivePerson(SIEN, APCEData.PersonClassDate)) then
	833	begin
	834	if(piece(TIUSiteParams, U, 8) = '1') and // Check to see if DEFAULT PRIMARY PROVIDER is by Location
	835	(SIEN = IntToStr(User.DUZ)) then
	836	ProviderList.AddProvider(SIEN, Piece(tmp,U,2) ,TRUE)
	837	else
	838	ProviderList.FPendingDefault := tmp;
	839	end;
	840	end;
	841	end;
	842
	843	function ValidateGAFDate(var GafDate: TFMDateTime): string;
	844	var
	845	DateMsg: string;
	846	OKDate: TFMDateTime;
	847
	848	begin
	849	Result := '';
	850	if(Patient.DateDied > 0) and (FMToday > Patient.DateDied) then
	851	begin
	852	DateMsg := 'Date of Death';
	853	OKDate := Patient.DateDied;
	854	end
	855	else
	856	begin
	857	DateMsg := 'Today';
	858	OKDate := FMToday;
	859	end;
	860	if(GafDate <= 0) then
	861	begin
	862	Result := 'A date is required to enter a GAF score. Date Determined changed to ' + DateMsg + '.';
	863	GafDate := OKDate;
	864	end
	865	else
	866	if(Patient.DateDied > 0) and (GafDate > Patient.DateDied) then
	867	begin
	868	Result := 'This patient died ' + FormatFMDateTime('mmm dd, yyyy hh:nn', Patient.DateDied) +
	869	'. Date GAF determined can not ' + CRLF +
	870	'be later than the date of death, and has been changed to ' + DateMsg + '.';
	871	GafDate := OKDate;
	872	end;
	873	end;
	874
	875	procedure GetVitalsFromDate(VitalStr: TStrings; PCEObj: TPCEData);
	876	var
	877	dte: TFMDateTime;
	878
	879	begin
	880	if(PCEObj.IsSecondaryVisit) then
	881	dte := PCEObj.NoteDateTime
	882	else
	883	dte := PCEObj.DateTime;
	884	GetVitalsFromEncDateTime(VitalStr, Patient.DFN, dte);
	885	end;
	886
	887	procedure GetVitalsFromNote(VitalStr: TStrings; PCEObj: TPCEData; ANoteIEN: Int64);
	888	begin
	889	if(PCEObj.IsSecondaryVisit) then
	890	GetVitalsFromEncDateTime(VitalStr, Patient.DFN, PCEObj.NoteDateTime)
	891	else
	892	GetVitalFromNoteIEN(VitalStr, Patient.DFN, ANoteIEN);
	893	end;
	894
	895	{ TPCEItem methods ------------------------------------------------------------------------- }
	896
	897	//function TPCEItem.DelimitedStr2: string;
	898	//added: 6/17/98
	899	//By: Robert Bott
	900	//Location: ISL
	901	//Purpose: Return comment string to be passed in RPC call.
	902	function TPCEItem.DelimitedStr2: string;
	903	{created delimited string to pass to broker}
	904	begin
	905	If Comment = '' then
	906	begin
	907	result := 'COM' + U + IntToStr(UNxtCommSeqNum) + U + NoPCEValue;
	908	end
	909	else
	910	begin
	911	Result := 'COM' + U + IntToStr(UNxtCommSeqNum) + U + Comment;
	912	end;
	913
	914	Inc(UNxtCommSeqNum); //set up for next comment
	915	end;
	916
	917	procedure TPCEItem.Assign(Src: TPCEItem);
	918	begin
	919	FDelete := Src.FDelete;
	920	FSend := Src.FSend;
	921	Code := Src.Code;
	922	Category := Src.Category;
	923	Narrative := Src.Narrative;
	924	Provider := Src.Provider;
	925	Comment := Src.Comment;
	926	end;
	927
	928	procedure TPCEItem.SetComment(const Value: String);
	929	begin
	930	FComment := Value;
	931	while (length(FComment) > 0) and (FComment[1] = '?') do
	932	delete(FComment,1,1);
	933	end;
	934
	935
	936	//procedure TPCEItem.Clear;
	937	//modified: 6/17/98
	938	//By: Robert Bott
	939	//Location: ISL
	940	//Purpose: Add Comments to PCE Items.
	941	procedure TPCEItem.Clear;
	942	{clear fields(properties) of class}
	943	begin
	944	FDelete := False;
	945	FSend := False;
	946	Code := '';
	947	Category := '';
	948	Narrative := '';
	949	Provider := 0;
	950	Comment := '';
	951	end;
	952
	953	//function TPCEItem.DelimitedStr: string;
	954	//modified: 6/17/98
	955	//By: Robert Bott
	956	//Location: ISL
	957	//Purpose: Add Comments to PCE Items.
	958	function TPCEItem.DelimitedStr: string;
	959	{created delimited string to pass to broker}
	960	var
	961	DelFlag: Char;
	962	begin
	963	if FDelete then DelFlag := '-' else DelFlag := '+';
	964	Result := DelFlag + U + Code + U + Category + U + Narrative;
	965	end;
	966
	967	function TPCEItem.ItemStr: string;
	968	{returns string to be assigned to Tlist in PCEData object}
	969	begin
	970	Result := Narrative;
	971	end;
	972
	973	function TPCEItem.Match(AnItem: TPCEItem): Boolean;
	974	{checks for match of Code, Category. and Item}
	975	begin
	976	Result := False;
	977	if (Code = AnItem.Code) and (Category = AnItem.Category) and (Narrative = AnItem.Narrative)
	978	then Result := True;
	979	end;
	980
	981	function TPCEItem.HasCPTStr: string;
	982	begin
	983	Result := '';
	984	end;
	985
	986	//procedure TPCEItem.SetFromString(const x: string);
	987	//modified: 6/17/98
	988	//By: Robert Bott
	989	//Location: ISL
	990	//Purpose: Add Comments to PCE Items.
	991	procedure TPCEItem.SetFromString(const x: string);
	992	{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative }
	993	begin
	994	Code := Piece(x, U, pnumCode);
	995	Category := Piece(x, U, pnumCategory);
	996	Narrative := Piece(x, U, pnumNarrative);
	997	Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
	998	Comment := Piece(x, U, pnumComment);
	999	end;
	1000
	1001
	1002	{ TPCEExams methods ------------------------------------------------------------------------- }
	1003
	1004	procedure TPCEExams.Assign(Src: TPCEItem);
	1005	begin
	1006	inherited Assign(Src);
	1007	Results := TPCEExams(Src).Results;
	1008	if Results = '' then Results := NoPCEValue;
	1009	end;
	1010
	1011	procedure TPCEExams.Clear;
	1012	{clear fields(properties) of class}
	1013	begin
	1014	inherited Clear;
	1015	// Provider := 0;
	1016	Results := NoPCEValue;
	1017	end;
	1018
	1019	//function TPCEExams.DelimitedStr: string;
	1020	//modified: 6/17/98
	1021	//By: Robert Bott
	1022	//Location: ISL
	1023	//Purpose: Add Comments to PCE Items.
	1024	function TPCEExams.DelimitedStr: string;
	1025	{created delimited string to pass to broker}
	1026	begin
	1027	Result := inherited DelimitedStr;
	1028	//Result := 'XAM' + Result + U + Results + U + IntToStr(Provider) +U + U + U +
	1029	Result := 'XAM' + Result + U + Results + U +U + U + U +
	1030	U + IntToStr(UNxtCommSeqNum);
	1031	end;
	1032
	1033	(*function TPCEExams.delimitedStrC: string;
	1034	begin
	1035	Result := inherited DelimitedStr;
	1036	Result := 'XAM' + Result + U + Results + U + IntToStr(Provider) +U + U + U +
	1037	U + comment;
	1038	end;
	1039	*)
	1040	function TPCEExams.HasCPTStr: string;
	1041	begin
	1042	Result := Code + ';AUTTEXAM(';
	1043	end;
	1044
	1045	function TPCEExams.ItemStr: string;
	1046	{returns string to be assigned to Tlist in PCEData object}
	1047	begin
	1048	if(Results <> NoPCEValue) then
	1049	Result := GetPCECodeString(TAG_XAMRESULTS, Results)
	1050	else
	1051	Result := '';
	1052	Result := Result + U + inherited ItemStr;
	1053	end;
	1054
	1055	procedure TPCEExams.SetFromString(const x: string);
	1056	{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
	1057	begin
	1058	inherited SetFromString(x);
	1059	// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
	1060	Results := Piece(x, U, pnumExamResults);
	1061	If results = '' then results := NoPCEValue;
	1062	end;
	1063
	1064
	1065	{ TPCESkin methods ------------------------------------------------------------------------- }
	1066
	1067	procedure TPCESkin.Assign(Src: TPCEItem);
	1068	var
	1069	SKSrc: TPCESkin;
	1070
	1071	begin
	1072	inherited Assign(Src);
	1073	SKSrc := TPCESkin(Src);
	1074	Results := SKSrc.Results;
	1075	Reading := SKSrc.Reading;
	1076	DTRead := SKSrc.DTRead;
	1077	DTGiven := SKSrc.DTGiven;
	1078	if Results = '' then Results := NoPCEValue;
	1079	end;
	1080
	1081	procedure TPCESkin.Clear;
	1082	{clear fields(properties) of class}
	1083	begin
	1084	inherited Clear;
	1085	// Provider := 0;
	1086	Results := NoPCEValue;
	1087	Reading := 0;
	1088	DTRead := 0.0; //What should dates be ititialized to?
	1089	DTGiven := 0.0;
	1090	end;
	1091
	1092	//function TPCESkin.DelimitedStr: string;
	1093	//modified: 6/17/98
	1094	//By: Robert Bott
	1095	//Location: ISL
	1096	//Purpose: Add Comments to PCE Items.
	1097	function TPCESkin.DelimitedStr: string;
	1098	{created delimited string to pass to broker}
	1099	begin
	1100	Result := inherited DelimitedStr;
	1101	//Result := 'SK' + Result + U + results + U + IntToStr(Provider) + U +
	1102	Result := 'SK' + Result + U + results + U + U +
	1103	IntToStr(Reading) + U + U + U + IntToStr(UNxtCommSeqNum);
	1104	//+ FloatToStr(DTRead) + U + FloatToStr(DTGiven);
	1105	end;
	1106
	1107	(*function TPCESkin.delimitedStrC: string;
	1108	begin
	1109	Result := inherited DelimitedStr;
	1110	Result := 'SK' + Result + U + results + U + IntToStr(Provider) + U +
	1111	IntToStr(Reading) + U + U + U + comment;
	1112	end;
	1113	*)
	1114	function TPCESkin.HasCPTStr: string;
	1115	begin
	1116	Result := Code + ';AUTTSK(';
	1117	end;
	1118
	1119	function TPCESkin.ItemStr: string;
	1120	{returns string to be assigned to Tlist in PCEData object}
	1121	begin
	1122	if(Results <> NoPCEValue) then
	1123	Result := GetPCECodeString(TAG_SKRESULTS, Results)
	1124	else
	1125	Result := '';
	1126	Result := Result + U;
	1127	if(Reading <> 0) then
	1128	Result := Result + IntToStr(Reading);
	1129	Result := Result + U + inherited ItemStr;
	1130	end;
	1131
	1132	procedure TPCESkin.SetFromString(const x: string);
	1133	{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
	1134	var
	1135	sRead, sDTRead, sDTGiven: String;
	1136	begin
	1137	inherited SetFromString(x);
	1138	// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
	1139	Results := Piece(x, U, pnumSkinResults);
	1140	sRead := Piece(x, U, pnumSkinReading);
	1141	sDTRead := Piece(x, U, pnumSkinDTRead);
	1142	sDtGiven := Piece(x, U, pnumSkinDTGiven);
	1143	If results = '' then results := NoPCEValue;
	1144
	1145	if sRead <> '' then
	1146	Reading := StrToInt(sRead);
	1147	if sDTRead <> '' then
	1148	DTRead := StrToFMDateTime(sDTRead);
	1149	if sDTGiven <> '' then
	1150	DTGiven := StrToFMDateTime(sDTGiven);
	1151
	1152	end;
	1153
	1154
	1155	{ TPCEHealth methods ------------------------------------------------------------------------- }
	1156
	1157	procedure TPCEHealth.Assign(Src: TPCEItem);
	1158	begin
	1159	inherited Assign(Src);
	1160	Level := TPCEHealth(Src).Level;
	1161	if Level = '' then Level := NoPCEValue;
	1162	end;
	1163
	1164	procedure TPCEHealth.Clear;
	1165	{clear fields(properties) of class}
	1166	begin
	1167	inherited Clear;
	1168	// Provider := 0;
	1169	Level := NoPCEValue;
	1170	end;
	1171
	1172	//function TPCEHealth.DelimitedStr: string;
	1173	//modified: 6/17/98
	1174	//By: Robert Bott
	1175	//Location: ISL
	1176	//Purpose: Add Comments to PCE Items.
	1177	function TPCEHealth.DelimitedStr: string;
	1178	{created delimited string to pass to broker}
	1179	begin
	1180	Result := inherited DelimitedStr;
	1181	// Result := 'HF' + Result + U + Level + U + IntToStr(Provider) + U + U + U +
	1182	Result := 'HF' + Result + U + Level + U + U + U + U +
	1183	U + IntToStr(UNxtCommSeqNum)+ U + GecRem;
	1184	end;
	1185
	1186	(*function TPCEHealth.delimitedStrC: string;
	1187	begin
	1188	Result := inherited DelimitedStr;
	1189	Result := 'HF' + Result + U + Level + U + IntToStr(Provider) + U + U + U +
	1190	U + comment;
	1191	end;
	1192	*)
	1193	function TPCEHealth.HasCPTStr: string;
	1194	begin
	1195	Result := Code + ';AUTTHF(';
	1196	end;
	1197
	1198	function TPCEHealth.ItemStr: string;
	1199	{returns string to be assigned to Tlist in PCEData object}
	1200	begin
	1201	if(Level <> NoPCEValue) then
	1202	Result := GetPCECodeString(TAG_HFLEVEL, Level)
	1203	else
	1204	Result := '';
	1205	Result := Result + U + inherited ItemStr;
	1206	end;
	1207
	1208	procedure TPCEHealth.SetFromString(const x: string);
	1209	{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
	1210	begin
	1211	inherited SetFromString(x);
	1212	// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
	1213	Level := Piece(x, U, pnumHFLevel);
	1214	if level = '' then level := NoPCEValue;
	1215	end;
	1216
	1217
	1218	{ TPCEImm methods ------------------------------------------------------------------------- }
	1219
	1220	procedure TPCEImm.Assign(Src: TPCEItem);
	1221	var
	1222	IMMSrc: TPCEImm;
	1223
	1224	begin
	1225	inherited Assign(Src);
	1226	IMMSrc := TPCEImm(Src);
	1227	Series := IMMSrc.Series;
	1228	Reaction := IMMSrc.Reaction;
	1229	Refused := IMMSrc.Refused;
	1230	Contraindicated := IMMSrc.Contraindicated;
	1231	if Series = '' then Series := NoPCEValue;
	1232	if Reaction ='' then Reaction := NoPCEValue;
	1233	end;
	1234
	1235	procedure TPCEImm.Clear;
	1236	{clear fields(properties) of class}
	1237	begin
	1238	inherited Clear;
	1239	// Provider := 0;
	1240	Series := NoPCEValue;
	1241	Reaction := NoPCEValue;
	1242	Refused := False; //not currently used
	1243	Contraindicated := false;
	1244	end;
	1245
	1246	//function TPCEImm.DelimitedStr: string;
	1247	//modified: 6/17/98
	1248	//By: Robert Bott
	1249	//Location: ISL
	1250	//Purpose: Add Comments to PCE Items.
	1251	function TPCEImm.DelimitedStr: string;
	1252	{created delimited string to pass to broker}
	1253	begin
	1254	Result := inherited DelimitedStr;
	1255	//Result := 'IMM' + Result + U + Series + U + IntToStr(Provider) + U + Reaction;
	1256	Result := 'IMM' + Result + U + Series + U + U + Reaction;
	1257	if Contraindicated then Result := Result + U + '1'
	1258	else Result := Result + U + '0';
	1259	Result := Result + U + U + IntToStr(UNxtCommSeqNum);
	1260	{the following two lines are not yet implemented in PCE side}
	1261	//if Refused then Result := Result + U + '1'
	1262	//else Result := Result + U + '0';
	1263	end;
	1264
	1265	(*function TPCEImm.delimitedStrC: string;
	1266	begin
	1267	Result := inherited DelimitedStr;
	1268	Result := 'IMM' + Result + U + Series + U + IntToStr(Provider) + U + Reaction;
	1269	if Contraindicated then Result := Result + U + '1'
	1270	else Result := Result + U + '0';
	1271	Result := Result + U + U + comment;
	1272	{the following two lines are not yet implemented in PCE side}
	1273	//if Refused then Result := Result + U + '1'
	1274	//else Result := Result + U + '0';
	1275	end;
	1276	*)
	1277	function TPCEImm.HasCPTStr: string;
	1278	begin
	1279	Result := Code + ';AUTTIMM(';
	1280	end;
	1281
	1282	function TPCEImm.ItemStr: string;
	1283	{returns string to be assigned to Tlist in PCEData object}
	1284	begin
	1285	if(Series <> NoPCEValue) then
	1286	Result := GetPCECodeString(TAG_IMMSERIES, Series)
	1287	else
	1288	Result := '';
	1289	Result := Result + U;
	1290	if(Reaction <> NoPCEValue) then
	1291	Result := Result + GetPCECodeString(TAG_IMMREACTION, Reaction);
	1292	Result := Result + U;
	1293	if(Contraindicated) then
	1294	Result := Result + 'X';
	1295	Result := Result + U + inherited ItemStr;
	1296	end;
	1297
	1298	procedure TPCEImm.SetFromString(const x: string);
	1299	{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
	1300	var
	1301	temp: String;
	1302	begin
	1303	inherited SetFromString(x);
	1304	// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
	1305	Series := Piece(x, U, pnumImmSeries);
	1306	Reaction := Piece(x, U, pnumImmReaction);
	1307	temp := Piece(x, U, pnumImmRefused);
	1308	if temp = '1' then refused := true else refused := false;
	1309	temp := Piece(x, U, pnumImmContra);
	1310	if temp = '1' then Contraindicated := true else Contraindicated := false;
	1311	if Series = '' then series := NoPCEValue;
	1312	if Reaction ='' then reaction := NoPCEValue;
	1313	end;
	1314
	1315
	1316
	1317	{ TPCEProc methods ------------------------------------------------------------------------- }
	1318
	1319	procedure TPCEProc.Assign(Src: TPCEItem);
	1320	begin
	1321	inherited Assign(Src);
	1322	Quantity := TPCEProc(Src).Quantity;
	1323	Modifiers := TPCEProc(Src).Modifiers;
	1324	Provider := TPCEProc(Src).Provider;
	1325	end;
	1326
	1327	procedure TPCEProc.Clear;
	1328	{clear fields(properties) of class}
	1329	begin
	1330	inherited Clear;
	1331	Quantity := 0;
	1332	Modifiers := '';
	1333	// Provider := 0;
	1334	Provider := 0;
	1335	end;
	1336
	1337	procedure TPCEProc.CopyProc(Dest: TPCEProc);
	1338	begin
	1339	Dest.FDelete := FDelete;
	1340	Dest.FSend := Fsend; //flag to send to broker
	1341	// Dest.Provider := Provider;
	1342	Dest.Provider := Provider;
	1343	Dest.Code := Code;
	1344	Dest.Category := Category;
	1345	Dest.Narrative := Narrative;
	1346	Dest.Comment := Comment;
	1347	Dest.Modifiers := Modifiers;
	1348	end;
	1349
	1350	//function TPCEProc.DelimitedStr: string;
	1351	//modified: 6/17/98
	1352	//By: Robert Bott
	1353	//Location: ISL
	1354	//Purpose: Add Comments to PCE Items.
	1355	function TPCEProc.DelimitedStr: string;
	1356	var
	1357	i, cnt: integer;
	1358	Mods, ModIEN, tmpProv: string;
	1359
	1360	{created delimited string to pass to broker}
	1361	begin
	1362	i := 1;
	1363	cnt := 0;
	1364	Mods := '';
	1365	repeat
	1366	ModIEN := piece(Modifiers, ';', i);
	1367	if(ModIEN <> '') then
	1368	begin
	1369	inc(cnt);
	1370	Mods := Mods + ';' + ModifierCode(ModIEN) + '/' + ModIEN;
	1371	inc(i);
	1372	end;
	1373	until (ModIEN = '');
	1374
	1375	Result := inherited DelimitedStr;
	1376	if Provider > 0 then tmpProv := IntToStr(Provider) else tmpProv := '';
	1377	Result := 'CPT' + Result + U + IntToStr(Quantity) + U + tmpProv
[460]	1378	+ U + U + U + IntToStr(cnt) + Mods + U + IntToStr(UNxtCommSeqNum) + U;
	1379	if Length(Result) > 250 then SetPiece(Result, U, 4, '');
[459]	1380	end;
	1381
	1382	(*function TPCEProc.delimitedStrC: string;
	1383	begin
	1384	Result := inherited DelimitedStr;
	1385	Result := 'CPT' + Result + U + IntToStr(Quantity) + U + IntToStr(Provider) +
	1386	U + U + U + U + comment;
	1387	end;
	1388	*)
	1389
	1390	function TPCEProc.Empty: boolean;
	1391	begin
	1392	Result := (Code = '') and (Category = '') and (Narrative = '') and
	1393	(Comment = '') and (Quantity = 0) and (Provider = 0) and (Modifiers = '');
	1394	end;
	1395
	1396	(*function TPCEProc.Match(AnItem: TPCEProc): Boolean; {NEW CODE - v20 testing only - RV}
	1397	begin
	1398	Result := inherited Match(AnItem) and (Modifiers = AnItem.Modifiers);
	1399	end;*)
	1400
	1401	function TPCEProc.ModText: string;
	1402	var
	1403	i: integer;
	1404	tmp: string;
	1405
	1406	begin
	1407	Result := '';
	1408	if(Modifiers <> '') then
	1409	begin
	1410	i := 1;
	1411	repeat
	1412	tmp := Piece(Modifiers,';',i);
	1413	if(tmp <> '') then
	1414	begin
	1415	tmp := ModifierName(tmp);
	1416	Result := Result + ' - ' + tmp;
	1417	end;
	1418	inc(i);
	1419	until (tmp = '');
	1420	end;
	1421	end;
	1422
	1423	function TPCEProc.ItemStr: string;
	1424	{returns string to be assigned to Tlist in PCEData object}
	1425	begin
	1426	if(Quantity > 1) then
	1427	Result := IntToStr(Quantity) + ' times'
	1428	else
	1429	Result := '';
	1430	Result := Result + U + inherited ItemStr + ModText;
	1431	end;
	1432
	1433	procedure TPCEProc.SetFromString(const x: string);
	1434	var
	1435	i, cnt: integer;
	1436	Mods: string;
	1437	{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
	1438	begin
	1439	inherited SetFromString(x);
	1440	Quantity := StrToIntDef(Piece(x, U, pnumProcQty), 1);
	1441	// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
	1442	Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
	1443	Modifiers := '';
	1444	Mods := Piece(x, U, pnumCPTMods);
	1445	cnt := StrToIntDef(Piece(Mods, ';', 1), 0);
	1446	if(cnt > 0) then
	1447	for i := 1 to cnt do
	1448	Modifiers := Modifiers + Piece(Piece(Mods, ';' , i+1), '/', 2) + ';';
	1449	end;
	1450
	1451
	1452	{ TPCEPat methods ------------------------------------------------------------------------- }
	1453
	1454	procedure TPCEPat.Assign(Src: TPCEItem);
	1455	begin
	1456	inherited Assign(Src);
	1457	Level := TPCEPat(Src).Level;
	1458	if Level = '' then Level := NoPCEValue;
	1459	end;
	1460
	1461	procedure TPCEPat.Clear;
	1462	{clear fields(properties) of class}
	1463	begin
	1464	inherited Clear;
	1465	// Provider := 0;
	1466	Level := NoPCEValue;
	1467	end;
	1468
	1469	//function TPCEPat.DelimitedStr: string;
	1470	//modified: 6/17/98
	1471	//By: Robert Bott
	1472	//Location: ISL
	1473	//Purpose: Add Comments to PCE Items.
	1474	function TPCEPat.DelimitedStr: string;
	1475	{created delimited string to pass to broker}
	1476	begin
	1477	Result := inherited DelimitedStr;
	1478	//Result := 'PED' + Result + U + Level + U + IntToStr(Provider) + U + U + U +
	1479	Result := 'PED' + Result + U + Level + U+ U + U + U +
	1480	U + IntToStr(UNxtCommSeqNum);
	1481	end;
	1482
	1483	(*function TPCEPat.delimitedStrC: string;
	1484	begin
	1485	Result := inherited DelimitedStr;
	1486	Result := 'PED' + Result + U + Level + U + IntToStr(Provider) + U + U + U +
	1487	U + comment;
	1488	end;
	1489	*)
	1490	function TPCEPat.HasCPTStr: string;
	1491	begin
	1492	Result := Code + ';AUTTEDT(';
	1493	end;
	1494
	1495	function TPCEPat.ItemStr: string;
	1496	{returns string to be assigned to Tlist in PCEData object}
	1497	begin
	1498	if(Level <> NoPCEValue) then
	1499	Result := GetPCECodeString(TAG_PEDLEVEL, Level)
	1500	else
	1501	Result := '';
	1502	Result := Result + U + inherited ItemStr;
	1503	end;
	1504
	1505	procedure TPCEPat.SetFromString(const x: string);
	1506	{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Qty ^ Prov }
	1507	begin
	1508	inherited SetFromString(x);
	1509	// Provider := StrToInt64Def(Piece(x, U, pnumProvider), 0);
	1510	Level := Piece(x, U, pnumPEDLevel);
	1511	if level = '' then level := NoPCEValue;
	1512	end;
	1513
	1514	{ TPCEDiag methods ------------------------------------------------------------------------- }
	1515
	1516	procedure TPCEDiag.Assign(Src: TPCEItem);
	1517	begin
	1518	inherited Assign(Src);
	1519	Primary := TPCEDiag(Src).Primary;
	1520	AddProb := TPCEDiag(Src).AddProb;
	1521	end;
	1522
	1523	//procedure TPCEDiag.Clear;
	1524	//modified: 6/17/98
	1525	//By: Robert Bott
	1526	//Location: ISL
	1527	//Purpose: Clear a diagnosis object.
	1528	procedure TPCEDiag.Clear;
	1529	{clear fields(properties) of class}
	1530	begin
	1531	inherited Clear;
	1532	Primary := False;
	1533	//Provider := 0;
	1534	AddProb := False;
	1535	end;
	1536
	1537	//function TPCEDiag.DelimitedStr: string;
	1538	//modified: 6/17/98
	1539	//By: Robert Bott
	1540	//Location: ISL
	1541	//Purpose: Create delimited string to pass to Broker.
	1542	function TPCEDiag.DelimitedStr: string;
	1543	{created delimited string to pass to broker}
	1544	var
	1545	ProviderStr: string; {jm 9/8/99}
	1546	begin
	1547	Result := inherited DelimitedStr;
	1548	if(AddProb) then
	1549	ProviderStr := IntToStr(fProvider)
	1550	else
	1551	ProviderStr := '';
	1552	Result := 'POV' + Result + U + BOOLCHAR[Primary] + U + ProviderStr + U +
	1553	BOOLCHAR[AddProb] + U + U + U;
	1554	if(SaveComment) then Result := Result + IntToStr(UNxtCommSeqNum);
[460]	1555	if Length(Result) > 250 then SetPiece(Result, U, 4, '');
[459]	1556	end;
	1557
	1558	function TPCEDiag.DelimitedStr2: string;
	1559	begin
	1560	If Comment = '' then
	1561	begin
	1562	SaveComment := (OldComment <> '') or (not AddProb);
	1563	if(SaveComment) then
	1564	result := 'COM' + U + IntToStr(UNxtCommSeqNum) + U + NoPCEValue
	1565	else
	1566	result := '';
	1567	end
	1568	else
	1569	begin
	1570	Result := 'COM' + U + IntToStr(UNxtCommSeqNum) + U + Comment;
	1571	SaveComment := TRUE;
	1572	end;
	1573	Inc(UNxtCommSeqNum);
	1574	end;
	1575
	1576	(*function TPCEDiag.DelimitedStrC: string;
	1577	{created delimited string for internal use - keep comment in same string.}
	1578	begin
	1579	Result := inherited DelimitedStr;
	1580	Result := 'POV' + Result + U + BOOLCHAR[Primary] + U + IntToStr(Provider)+
	1581	U + BOOLCHAR[AddProb] + U + U + U + comment;
	1582	end;
	1583	*)
	1584	function TPCEDiag.ItemStr: string;
	1585	{returns string to be assigned to Tlist in PCEData object}
	1586	begin
	1587	if Primary then
	1588	Result := 'Primary'
	1589	else
	1590	Result := 'Secondary';
	1591	// This may change in the future if we add a check box to the grid
	1592	if(AddProb) then
	1593	Result := 'Add' + U + Result
	1594	else
	1595	Result := U + Result;
	1596
	1597	Result := Result + U + inherited ItemStr;
	1598	end;
	1599
	1600	procedure TPCEDiag.Send;
	1601	//marks diagnosis to be sent;
	1602	begin
	1603	Fsend := True;
	1604	end;
	1605
	1606	//procedure TPCEDiag.SetFromString(const x: string);
	1607	//modified: 6/17/98
	1608	//By: Robert Bott
	1609	//Location: ISL
	1610	//Purpose: Sets fields to pieces passed from server.
	1611	procedure TPCEDiag.SetFromString(const x: string);
	1612	{ sets fields to pieces passed from server: TYP ^ Code ^ Category ^ Narrative ^ Primary ^ ^ ^ Comment }
	1613	begin
	1614	inherited SetFromString(x);
	1615	OldComment := Comment;
	1616	Primary := (Piece(x, U, pnumDiagPrimary) = '1');
	1617	//Provider := StrToInt64Def(Piece(x, U, pnumProvider),0);
	1618	AddProb := (Piece(x, U, pnumDiagAdd2PL) = '1');
	1619	end;
	1620
	1621	{ TPCEData methods ------------------------------------------------------------------------- }
	1622
	1623	constructor TPCEData.Create;
	1624	begin
	1625	FDiagnoses := TList.Create;
	1626	FProcedures := TList.Create;
	1627	FImmunizations := TList.Create;
	1628	FSkinTests := TList.Create;
	1629	FVisitType := TPCEProc.Create;
	1630	FPatientEds := TList.Create;
	1631	FHealthFactors := TList.Create;
	1632	fExams := TList.Create;
	1633	FProviders := TPCEProviderList.Create;
	1634	FSCRelated := SCC_NA;
	1635	FAORelated := SCC_NA;
	1636	FIRRelated := SCC_NA;
	1637	FECRelated := SCC_NA;
	1638	FMSTRelated := SCC_NA;
	1639	FHNCRelated := SCC_NA;
	1640	FCVRelated := SCC_NA;
	1641	FSCChanged := False;
	1642	end;
	1643
	1644	destructor TPCEData.Destroy;
	1645	var
	1646	i: Integer;
	1647	begin
	1648	with FDiagnoses do for i := 0 to Count - 1 do TPCEDiag(Items[i]).Free;
	1649	with FProcedures do for i := 0 to Count - 1 do TPCEProc(Items[i]).Free;
	1650	with FImmunizations do for i := 0 to Count - 1 do TPCEImm(Items[i]).Free;
	1651	with FSkinTests do for i := 0 to Count - 1 do TPCESkin(Items[i]).Free;
	1652	with FPatientEds do for i := 0 to Count - 1 do TPCEPat(Items[i]).Free;
	1653	with FHealthFactors do for i := 0 to Count - 1 do TPCEHealth(Items[i]).Free;
	1654	with FExams do for i := 0 to Count - 1 do TPCEExams(Items[i]).Free;
	1655	FVisitType.Free;
	1656	FDiagnoses.Free;
	1657	FProcedures.Free;
	1658	FImmunizations.Free;
	1659	FSkinTests.free;
	1660	FPatientEds.Free;
	1661	FHealthFactors.Free;
	1662	FExams.Free;
	1663	FProviders.Free;
	1664	inherited Destroy;
	1665	end;
	1666
	1667	procedure TPCEData.Clear;
	1668
	1669	procedure ClearList(AList: TList);
	1670	var
	1671	i: Integer;
	1672
	1673	begin
	1674	for i := 0 to AList.Count - 1 do
	1675	TObject(AList[i]).Free;
	1676	AList.Clear;
	1677	end;
	1678
	1679	begin
	1680	FEncDateTime := 0;
	1681	FNoteDateTime := 0;
	1682	FEncLocation := 0;
	1683	FEncSvcCat := 'A';
	1684	FEncInpatient := FALSE;
	1685	FEncUseCurr := FALSE;
	1686	FStandAlone := FALSE;
	1687	FStandAloneLoaded := FALSE;
	1688	FParent := '';
	1689	FHistoricalLocation := '';
	1690	FSCRelated := SCC_NA;
	1691	FAORelated := SCC_NA;
	1692	FIRRelated := SCC_NA;
	1693	FECRelated := SCC_NA;
	1694	FMSTRelated := SCC_NA;
	1695	FHNCRelated := SCC_NA;
	1696	FCVRelated := SCC_NA;
	1697
	1698	ClearList(FDiagnoses);
	1699	ClearList(FProcedures);
	1700	ClearList(FImmunizations);
	1701	ClearList(FSkinTests);
	1702	ClearList(FPatientEds);
	1703	ClearList(FHealthFactors);
	1704	ClearList(FExams);
	1705
	1706	FVisitType.Clear;
	1707	FProviders.Clear;
	1708	FSCChanged := False;
	1709	FNoteIEN := 0;
	1710	FNoteTitle := 0;
	1711	end;
	1712
	1713	procedure TPCEData.CopyDiagnoses(Dest: TStrings);
	1714	begin
	1715	CopyPCEItems(FDiagnoses, Dest, TPCEDiag);
	1716	end;
	1717
	1718	procedure TPCEData.CopyProcedures(Dest: TStrings);
	1719	begin
	1720	CopyPCEItems(FProcedures, Dest, TPCEProc);
	1721	end;
	1722
	1723	procedure TPCEData.CopyImmunizations(Dest: TStrings);
	1724	begin
	1725	CopyPCEItems(FImmunizations, Dest, TPCEImm);
	1726	end;
	1727
	1728	procedure TPCEData.CopySkinTests(Dest: TStrings);
	1729	begin
	1730	CopyPCEItems(FSkinTests, Dest, TPCESkin);
	1731	end;
	1732
	1733	procedure TPCEData.CopyPatientEds(Dest: TStrings);
	1734	begin
	1735	CopyPCEItems(FPatientEds, Dest, TPCEPat);
	1736	end;
	1737
	1738	procedure TPCEData.CopyHealthFactors(Dest: TStrings);
	1739	begin
	1740	CopyPCEItems(FHealthFactors, Dest, TPCEHealth);
	1741	end;
	1742
	1743	procedure TPCEData.CopyExams(Dest: TStrings);
	1744	begin
	1745	CopyPCEItems(FExams, Dest, TPCEExams);
	1746	end;
	1747
	1748	function TPCEData.GetVisitString: string;
	1749	begin
	1750	Result := IntToStr(FEncLocation) + ';' + FloatToStr(VisitDateTime) + ';' + FEncSvcCat;
	1751	end;
	1752
	1753	function TPCEData.GetCPTRequired: Boolean;
	1754	begin
	1755	Result := (([ndDiag, ndProc] * NeededPCEData) <> []);
	1756	end;
	1757
	1758	procedure TPCEData.PCEForNote(NoteIEN: Integer; EditObj: TPCEData);
	1759	(*const
	1760	NULL_STR = '';
	1761	begin
	1762	PCEForNote(NoteIEN, EditObj, NULL_STR);
	1763	end;
	1764
	1765	procedure TPCEData.PCEForNote(NoteIEN: Integer; EditObj: TPCEData; DCSummAdmitString: string);*)
	1766	var
	1767	i, j: Integer;
	1768	TmpCat, TmpVStr: string;
	1769	x: string;
	1770	DoCopy, IsVisit: Boolean;
	1771	PCEList, VisitTypeList: TStringList;
	1772	ADiagnosis: TPCEDiag;
	1773	AProcedure: TPCEProc;
	1774	AImmunization: TPCEImm;
	1775	ASkinTest: TPCESkin;
	1776	APatientEd: TPCEPat;
	1777	AHealthFactor: TPCEHealth;
	1778	AExam: TPCEExams;
	1779	FileVStr: string;
	1780	FileIEN: integer;
	1781	GetCat, DoRestore: boolean;
	1782	FRestDate: TFMDateTime;
	1783	// AProvider: TPCEProvider; {6/9/99}
	1784
	1785	function SCCValue(x: string): Integer;
	1786	begin
	1787	Result := SCC_NA;
	1788	if Piece(x, U, 3) = '1' then Result := SCC_YES;
	1789	if Piece(x, U, 3) = '0' then Result := SCC_NO;
	1790	end;
	1791
	1792	function AppendComment(x: string): String;
	1793	begin
	1794	//check for comment append string if a comment exists
	1795	If (((i+1) <= (PCEList.Count - 1)) and (Copy(PCEList[(i+1)], 1, 3) = 'COM')) then
	1796	begin
	1797	//remove last piece (comment sequence number) from x.
	1798	While x[length(x)] <> U do
	1799	x := Copy(X,0,(length(x)-1));
	1800	//add last piece of comment to x
	1801	x := X + Piece (PCEList[(i+1)],U,3);
	1802	end;
	1803	result := x;
	1804	end;
	1805
	1806	begin
	1807	(* if DCSummAdmitString <> '' then
	1808	TmpVStr := DCSummAdmitString
	1809	else*) if(NoteIEN < 1) then
	1810	TmpVStr := Encounter.VisitStr
	1811	else
	1812	begin
	1813	TmpVStr := VisitStrForNote(NoteIEN);
	1814	if(FEncSvcCat = #0) then
	1815	GetCat :=TRUE
	1816	else
	1817	if(GetVisitString = '0;0;A') then
	1818	begin
	1819	FEncLocation := StrToIntDef(Piece(TmpVStr, ';', 1), 0);
	1820	FEncDateTime := StrToFloatDef(Piece(TmpVStr, ';', 2),0);
	1821	GetCat :=TRUE
	1822	end
	1823	else
	1824	GetCat := FALSE;
	1825	if(GetCat) then
	1826	begin
	1827	TmpCat := Piece(TmpVStr, ';', 3);
	1828	if(TmpCat <> '') then
	1829	FEncSvcCat := TmpCat[1];
	1830	end;
	1831	end;
	1832
	1833	if(assigned(EditObj)) then
	1834	begin
	1835	if(copy(TmpVStr,1,2) <> '0;') and // has location
	1836	(pos(';0;',TmpVStr) = 0) and // has time
	1837	(EditObj.GetVisitString = TmpVStr) then
	1838	begin
	1839	if(FEncSvcCat = 'H') and (FEncInpatient) then
	1840	DoCopy := (FNoteDateTime = EditObj.FNoteDateTime)
	1841	else
	1842	DoCopy := TRUE;
	1843	if(DoCopy) then
	1844	begin
	1845	if(EditObj <> Self) then
	1846	begin
	1847	EditObj.CopyPCEData(Self);
	1848	FNoteTitle := 0;
	1849	FNoteIEN := 0;
	1850	end;
	1851	exit;
	1852	end;
	1853	end;
	1854	end;
	1855
	1856	TmpCat := Piece(TmpVStr, ';', 3);
	1857	if(TmpCat <> '') then
	1858	FEncSvcCat := TmpCat[1]
	1859	else
	1860	FEncSvcCat := #0;
	1861	FEncLocation := StrToIntDef(Piece(TmpVStr,';',1),0);
	1862	FEncDateTime := StrToFloatDef(Piece(TmpVStr, ';', 2),0);
	1863
	1864	if(IsSecondaryVisit and (FEncLocation > 0)) then
	1865	begin
	1866	FileIEN := USE_CURRENT_VISITSTR;
	1867	FileVStr := IntToStr(FEncLocation) + ';' + FloatToStr(FNoteDateTime) + ';' +
	1868	GetLocSecondaryVisitCode(FEncLocation);
	1869	DoRestore := TRUE;
	1870	FRestDate := FEncDateTime;
	1871	end
	1872	else
	1873	begin
	1874	DoRestore := FALSE;
	1875	FRestDate := 0;
	1876	FileIEN := NoteIEN;
	1877	(* if DCSummAdmitString <> '' then
	1878	FileVStr := DCSummAdmitString
	1879	else*) if(FileIEN < 0) then
	1880	FileVStr := Encounter.VisitStr
	1881	else
	1882	FileVStr := '';
	1883	end;
	1884
	1885	Clear;
	1886	PCEList := TStringList.Create;
	1887	VisitTypeList := TStringList.Create;
	1888	try
	1889	LoadPCEDataForNote(PCEList, FileIEN, FileVStr); // calls broker RPC to load data
	1890	FNoteIEN := NoteIEN;
	1891	for i := 0 to PCEList.Count - 1 do
	1892	begin
	1893	x := PCEList[i];
	1894	if Copy(x, 1, 4) = 'HDR^' then // HDR ^ Inpatient ^ ProcReq ^ VStr ^ Provider
	1895	{header information-------------------------------------------------------------}
	1896	begin
	1897	FEncInpatient := Piece(x, U, 2) = '1';
	1898	//FCPTRequired := Piece(x, U, 3) = '1';
	1899	//FNoteHasCPT := Piece(x, U, 6) = '1'; //4/21/99 error! PIECE 3 = cptRequired, not HasCPT!
	1900	FEncLocation := StrToIntDef(Piece(Piece(x, U, 4), ';', 1), 0);
	1901	if DoRestore then
	1902	begin
	1903	FEncSvcCat := 'H';
	1904	FEncDateTime := FRestDate;
	1905	FNoteDateTime := MakeFMDateTime(Piece(Piece(x, U, 4), ';', 2));
	1906	end
	1907	else
	1908	begin
	1909	FEncDateTime := MakeFMDateTime(Piece(Piece(x, U, 4), ';', 2));
	1910	FEncSvcCat := CharAt(Piece(Piece(x, U, 4), ';', 3), 1);
	1911	end;
	1912	//FEncProvider := StrToInt64Def(Piece(x, U, 5), 0);
	1913	ListVisitTypeByLoc(VisitTypeList, FEncLocation, FEncDateTime);
	1914	//set the values needed fot the RPCs
	1915	SetRPCEncLocation(FEncLocation);
	1916	// SetRPCEncDateTime(FEncDateTime);
	1917	end;
	1918	{visit information--------------------------------------------------------------}
	1919	if Copy(x, 1, 7) = 'VST^DT^' then
	1920	begin
	1921	if DoRestore then
	1922	begin
	1923	FEncDateTime := FRestDate;
	1924	FNoteDateTime := MakeFMDateTime(Piece(x, U, 3));
	1925	end
	1926	else
	1927	FEncDateTime := MakeFMDateTime(Piece(x, U, 3));
	1928	end;
	1929	if Copy(x, 1, 7) = 'VST^HL^' then FEncLocation := StrToIntDef(Piece(x, U, 3), 0);
	1930	if Copy(x, 1, 7) = 'VST^VC^' then
	1931	begin
	1932	if DoRestore then
	1933	FEncSvcCat := 'H'
	1934	else
	1935	FEncSvcCat := CharAt(x, 8);
	1936	end;
	1937	if Copy(x, 1, 7) = 'VST^PS^' then FEncInpatient := CharAt(x, 8) = '1';
	1938	{6/10/99}//if Copy(x, 1, 4) = 'PRV^' then FEncProvider := StrToInt64Def(Piece(x, U, 2), 0);
	1939	if Copy(x, 1, 7) = 'VST^SC^' then FSCRelated := SCCValue(x);
	1940	if Copy(x, 1, 7) = 'VST^AO^' then FAORelated := SCCValue(x);
	1941	if Copy(x, 1, 7) = 'VST^IR^' then FIRRelated := SCCValue(x);
	1942	if Copy(x, 1, 7) = 'VST^EC^' then FECRelated := SCCValue(x);
	1943	if Copy(x, 1, 8) = 'VST^MST^' then FMSTRelated := SCCValue(x);
	1944	// if HNCOK and (Copy(x, 1, 8) = 'VST^HNC^') then
	1945	if Copy(x, 1, 8) = 'VST^HNC^' then FHNCRelated := SCCValue(x);
	1946	if Copy(x, 1, 7) = 'VST^CV^' then FCVRelated := SCCValue(x);
	1947	if (Copy(x, 1, 3) = 'PRV') and (CharAt(x, 4) <> '-') then
	1948	{Providers---------------------------------------------------------------------}
	1949	begin
	1950	FProviders.Add(x);
	1951	end;
	1952
	1953	if (Copy(x, 1, 3) = 'POV') and (CharAt(x, 4) <> '-') then
	1954	{'POV'=Diagnosis--------------------------------------------------------------}
	1955	begin
	1956	//check for comment append string if a comment exists
	1957	x := AppendComment(x);
	1958	ADiagnosis := TPCEDiag.Create;
	1959	ADiagnosis.SetFromString(x);
	1960	FDiagnoses.Add(ADiagnosis);
	1961	end;
	1962	if (Copy(x, 1, 3) = 'CPT') and (CharAt(x, 4) <> '-') then
	1963	{CPT (procedure) information--------------------------------------------------}
	1964	begin
	1965	x := AppendComment(x);
	1966
	1967	IsVisit := False;
	1968	with VisitTypeList do for j := 0 to Count - 1 do
	1969	if Pieces(x, U, 2, 4) = Strings[j] then IsVisit := True;
	1970	if IsVisit and (FVisitType.Code = '') then FVisitType.SetFromString(x) else
	1971	begin
	1972	AProcedure := TPCEProc.Create;
	1973	AProcedure.SetFromString(x);
	1974	AProcedure.fIsOldProcedure := TRUE;
	1975	FProcedures.Add(AProcedure);
	1976	end; {if IsVisit}
	1977	end; {if Copy}
	1978	if (Copy(x, 1, 3) = 'IMM') and (CharAt(x, 4) <> '-') then
	1979	{Immunizations ---------------------------------------------------------------}
	1980	begin
	1981	x := AppendComment(x);
	1982	AImmunization := TPCEImm.Create;
	1983	AImmunization.SetFromString(x);
	1984	FImmunizations.Add(AImmunization);
	1985	end;
	1986	if (Copy(x, 1, 2) = 'SK') and (CharAt(x, 3) <> '-') then
	1987	{Skin Tests-------------------------------------------------------------------}
	1988	begin
	1989	x := AppendComment(x);
	1990	ASkinTest := TPCESkin.Create;
	1991	ASkinTest.SetFromString(x);
	1992	FSkinTests.Add(ASkinTest);
	1993	end;
	1994	if (Copy(x, 1, 3) = 'PED') and (CharAt(x, 3) <> '-') then
	1995	{Patient Educations------------------------------------------------------------}
	1996	begin
	1997	x := AppendComment(x);
	1998	APatientEd := TPCEpat.Create;
	1999	APatientEd.SetFromString(x);
	2000	FpatientEds.Add(APatientEd);
	2001	end;
	2002	if (Copy(x, 1, 2) = 'HF') and (CharAt(x, 3) <> '-') then
	2003	{Health Factors----------------------------------------------------------------}
	2004	begin
	2005	x := AppendComment(x);
	2006	AHealthFactor := TPCEHealth.Create;
	2007	AHealthFactor.SetFromString(x);
	2008	FHealthFactors.Add(AHealthFactor);
	2009	end;
	2010	if (Copy(x, 1, 3) = 'XAM') and (CharAt(x, 3) <> '-') then
	2011	{Exams ------------------------------------------------------------------------}
	2012	begin
	2013	x := AppendComment(x);
	2014	AExam := TPCEExams.Create;
	2015	AExam.SetFromString(x);
	2016	FExams.Add(AExam);
	2017	end;
	2018
	2019	end;
	2020	finally
	2021	PCEList.Free;
	2022	VisitTypeList.Free;
	2023	end;
	2024	end;
	2025
	2026	//procedure TPCEData.Save;
	2027	//modified: 6/17/98
	2028	//By: Robert Bott
	2029	//Location: ISL
	2030	//Purpose: Add Comments to PCE Items.
	2031	procedure TPCEData.Save;
	2032	{ pass the changes to the encounter to DATA2PCE,
	2033	Pieces: Subscript^Code^Qualifier^Category^Narrative^Delete }
	2034	var
	2035	i: Integer;
	2036	x, AVisitStr, EncName, Temp2: string;
	2037	PCEList: TStringList;
	2038	FileCat: char;
	2039	FileDate: TFMDateTime;
	2040	FileNoteIEN: integer;
	2041	dstring1,dstring2: pchar; //used to separate former DelimitedStr variable
	2042	// into two strings, the second being for the comment.
	2043
	2044	begin
	2045	PCEList := TStringList.Create;
	2046	UNxtCommSeqNum := 1;
	2047	try
	2048	with PCEList do
	2049	begin
	2050	if(IsSecondaryVisit) then
	2051	begin
	2052	FileCat := GetLocSecondaryVisitCode(FEncLocation);
	2053	FileDate := FNoteDateTime;
	2054	FileNoteIEN := NoteIEN;
	2055	if((NoteIEN > 0) and ((FParent = '') or (FParent = '0'))) then
	2056	FParent := GetVisitIEN(NoteIEN);
	2057	end
	2058	else
	2059	begin
	2060	FileCat := FEncSvcCat;
	2061	FileDate := FEncDateTime;
	2062	FileNoteIEN := 0;
	2063	end;
	2064	AVisitStr := IntToStr(FEncLocation) + ';' + FloatToStr(FileDate) + ';' + FileCat;
	2065	Add('HDR^' + BOOLCHAR[FEncInpatient] + U + U + AVisitStr);
	2066	// Add('HDR^' + BOOLCHAR[FEncInpatient] + U + BOOLCHAR[FNoteHasCPT] + U + AVisitStr);
	2067	// set up list that can be passed via broker to set up array for DATA2PCE
	2068	Add('VST^DT^' + FloatToStr(FileDate)); // Encounter Date/Time
	2069	Add('VST^PT^' + Patient.DFN); // Encounter Patient //DFN
	2070	if(FEncLocation > 0) then
	2071	Add('VST^HL^' + IntToStr(FEncLocation)); // Encounter Location
	2072	Add('VST^VC^' + FileCat); // Encounter Service Category
	2073	if(StrToIntDef(FParent,0) > 0) then
	2074	Add('VST^PR^' + FParent); // Parent for secondary visit
	2075	if(FileCat = 'E') and (FHistoricalLocation <> '') then
	2076	Add('VST^OL^' + FHistoricalLocation); // Outside Location
	2077
	2078	//Add('PRV^' + IntToStr(FEncProvider)); // Encounter Provider
	2079	//Add('PRV^' + IntToStr(UProvider.IEN)); // Encounter Provider
	2080	{with FProviders do for i := 0 to Count - 1 do with TPCEProvider(Items[i]) do
	2081	begin
	2082	PCEList.Add(DelimitedStr);
	2083	end;}
	2084	PCEList.AddStrings(FProviders);
	2085
	2086	if FSCChanged then
	2087	begin
	2088	if FSCRelated <> SCC_NA then Add('VST^SC^' + IntToStr(FSCRelated));
	2089	if FAORelated <> SCC_NA then Add('VST^AO^' + IntToStr(FAORelated));
	2090	if FIRRelated <> SCC_NA then Add('VST^IR^' + IntToStr(FIRRelated));
	2091	if FECRelated <> SCC_NA then Add('VST^EC^' + IntToStr(FECRelated));
	2092	if FMSTRelated <> SCC_NA then Add('VST^MST^' + IntToStr(FMSTRelated));
	2093	// if HNCOK and (FHNCRelated <> SCC_NA) then
	2094	if FHNCRelated <> SCC_NA then Add('VST^HNC^' + IntToStr(FHNCRelated));
	2095	if FCVRelated <> SCC_NA then Add('VST^CV^' + IntToStr(FCVRelated));
	2096	end;
	2097	with FDiagnoses do for i := 0 to Count - 1 do with TPCEDiag(Items[i]) do
	2098	if FSend then
	2099	begin
	2100	Temp2 := DelimitedStr2; // Call first to make sure SaveComment is set.
	2101	if(SaveComment) then
	2102	dec(UNxtCommSeqNum);
	2103	fProvider := FProviders.PCEProvider;
	2104	// Provides user with list of dx when signing orders - Billing Aware
	2105	PCEList.Add(DelimitedStr);
	2106	if(SaveComment) then
	2107	begin
	2108	inc(UNxtCommSeqNum);
	2109	if(Temp2 <> '') then
	2110	PCEList.Add(Temp2);
	2111	end;
	2112	end;
	2113	with FProcedures do for i := 0 to Count - 1 do with TPCEProc(Items[i]) do
	2114	if FSend then
	2115	begin
	2116	PCEList.Add(DelimitedStr);
	2117	PCEList.Add(DelimitedStr2);
	2118	end;
	2119	with FImmunizations do for i := 0 to Count - 1 do with TPCEImm(Items[i]) do
	2120	if FSend then
	2121	begin
	2122	PCEList.Add(DelimitedStr);
	2123	PCEList.Add(DelimitedStr2);
	2124	end;
	2125	with FSkinTests do for i := 0 to Count - 1 do with TPCESkin(Items[i]) do
	2126	if FSend then
	2127	begin
	2128	PCEList.Add(DelimitedStr);
	2129	PCEList.Add(DelimitedStr2);
	2130	end;
	2131	with FPatientEds do for i := 0 to Count - 1 do with TPCEPat(Items[i]) do
	2132	if FSend then
	2133	begin
	2134	PCEList.Add(DelimitedStr);
	2135	PCEList.Add(DelimitedStr2);
	2136	end;
	2137	with FHealthFactors do for i := 0 to Count - 1 do with TPCEHealth(Items[i]) do
	2138	if FSend then
	2139	begin
	2140	PCEList.Add(DelimitedStr);
	2141	PCEList.Add(DelimitedStr2);
	2142	end;
	2143	with FExams do for i := 0 to Count - 1 do with TPCEExams(Items[i]) do
	2144	if FSend then
	2145	begin
	2146	PCEList.Add(DelimitedStr);
	2147	PCEList.Add(DelimitedStr2);
	2148	end;
	2149
	2150	with FVisitType do
	2151	begin
	2152	if Code = '' then Fsend := false;
	2153	if FSend then
	2154	begin
	2155	PCEList.Add(DelimitedStr);
	2156	PCEList.Add(DelimitedStr2);
	2157	end;
	2158	end;
	2159	// call DATA2PCE (in background)
	2160	SavePCEData(PCEList, FileNoteIEN, FEncLocation);
	2161
	2162	// turn off 'Send' flags and remove items that were deleted
	2163	with FDiagnoses do for i := Count - 1 downto 0 do with TPCEDiag(Items[i]) do
	2164	begin
	2165	FSend := False;
	2166	if FDelete then
	2167	begin
	2168	TPCEDiag(Items[i]).Free;
	2169	Delete(i);
	2170	end;
	2171	end;
	2172	with FProcedures do for i := Count - 1 downto 0 do with TPCEProc(Items[i]) do
	2173	begin
	2174	FSend := False;
	2175	if FDelete then
	2176	begin
	2177	TPCEProc(Items[i]).Free;
	2178	Delete(i);
	2179	end;
	2180	end;
	2181	with FImmunizations do for i := Count - 1 downto 0 do with TPCEImm(Items[i]) do
	2182	begin
	2183	FSend := False;
	2184	if FDelete then
	2185	begin
	2186	TPCEImm(Items[i]).Free;
	2187	Delete(i);
	2188	end;
	2189	end;
	2190	with FSkinTests do for i := Count - 1 downto 0 do with TPCESkin(Items[i]) do
	2191	begin
	2192	FSend := False;
	2193	if FDelete then
	2194	begin
	2195	TPCESkin(Items[i]).Free;
	2196	Delete(i);
	2197	end;
	2198	end;
	2199	with FPatientEds do for i := Count - 1 downto 0 do with TPCEPat(Items[i]) do
	2200	begin
	2201	FSend := False;
	2202	if FDelete then
	2203	begin
	2204	TPCEPat(Items[i]).Free;
	2205	Delete(i);
	2206	end;
	2207	end;
	2208	with FHealthFactors do for i := Count - 1 downto 0 do with TPCEHealth(Items[i]) do
	2209	begin
	2210	FSend := False;
	2211	if FDelete then
	2212	begin
	2213	TPCEHealth(Items[i]).Free;
	2214	Delete(i);
	2215	end;
	2216	end;
	2217	with FExams do for i := Count - 1 downto 0 do with TPCEExams(Items[i]) do
	2218	begin
	2219	FSend := False;
	2220	if FDelete then
	2221	begin
	2222	TPCEExams(Items[i]).Free;
	2223	Delete(i);
	2224	end;
	2225	end;
	2226
	2227	for i := FProviders.Count - 1 downto 0 do
	2228	begin
	2229	if(FProviders.ProviderData[i].Delete) then
	2230	FProviders.Delete(i);
	2231	end;
	2232
	2233	if FVisitType.FDelete then FVisitType.Clear else FVisitType.FSend := False;
	2234	end; {with PCEList}
	2235	//if (FProcedures.Count > 0) or (FVisitType.Code <> '') then FCPTRequired := False;
	2236
	2237	// update the Changes object
	2238	EncName := FormatFMDateTime('mmm dd,yy hh:nn', FileDate);
	2239	x := StrVisitType;
	2240	if Length(x) > 0 then Changes.Add(CH_PCE, 'V' + AVisitStr, x, EncName, CH_SIGN_NA);
	2241	x := StrProcedures;
	2242	if Length(x) > 0 then Changes.Add(CH_PCE, 'P' + AVisitStr, x, EncName, CH_SIGN_NA);
	2243	x := StrDiagnoses;
	2244	if Length(x) > 0 then Changes.Add(CH_PCE, 'D' + AVisitStr, x, EncName, CH_SIGN_NA);
	2245	x := StrImmunizations;
	2246	if Length(x) > 0 then Changes.Add(CH_PCE, 'I' + AVisitStr, x, EncName, CH_SIGN_NA);
	2247	x := StrSkinTests;
	2248	if Length(x) > 0 then Changes.Add(CH_PCE, 'S' + AVisitStr, x, EncName, CH_SIGN_NA);
	2249	x := StrPatientEds;
	2250	if Length(x) > 0 then Changes.Add(CH_PCE, 'A' + AVisitStr, x, EncName, CH_SIGN_NA);
	2251	x := StrHealthFactors;
	2252	if Length(x) > 0 then Changes.Add(CH_PCE, 'H' + AVisitStr, x, EncName, CH_SIGN_NA);
	2253	x := StrExams;
	2254	if Length(x) > 0 then Changes.Add(CH_PCE, 'E' + AVisitStr, x, EncName, CH_SIGN_NA);
	2255
	2256
	2257	finally
	2258	PCEList.Free;
	2259	end;
	2260	end;
	2261
	2262	function TPCEData.MatchItem(AList: TList; AnItem: TPCEItem): Integer;
	2263	{ return index in AList of matching item }
	2264	var
	2265	i: Integer;
	2266	begin
	2267	Result := -1;
	2268	// with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then
	2269	with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then
	2270	// with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) then
	2271	begin
	2272	Result := i;
	2273	break;
	2274	end;
	2275	end;
	2276
	2277	procedure TPCEData.MarkDeletions(PreList: TList; PostList: TStrings);
	2278	{mark items that need deleted}
	2279	var
	2280	i, j: Integer;
	2281	MatchFound: Boolean;
	2282	PreItem, PostItem: TPCEItem;
	2283	begin
	2284	with PreList do for i := 0 to Count - 1 do
	2285	begin
	2286	PreItem := TPCEItem(Items[i]);
	2287	MatchFound := False;
	2288	with PostList do for j := 0 to Count - 1 do
	2289	begin
	2290	PostItem := TPCEItem(Objects[j]);
	2291	// if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;
	2292	if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;
	2293	// if (PreItem.Match(PostItem)) then MatchFound := True;
	2294	end;
	2295	if not MatchFound then
	2296	begin
	2297	PreItem.FDelete := True;
	2298	PreItem.FSend := True;
	2299	end;
	2300	end;
	2301	end;
	2302
	2303	procedure TPCEData.SetDiagnoses(Src: TStrings; FromForm: boolean = TRUE);
	2304	{ load diagnoses for this encounter into TPCEDiag records, assumes all diagnoses for the
	2305	encounter will be listed in Src and marks those that are not in Src for deletion }
	2306	var
	2307	i, MatchIndex: Integer;
	2308	SrcDiagnosis, CurDiagnosis, PrimaryDiag: TPCEDiag;
	2309	begin
	2310	if FromForm then MarkDeletions(FDiagnoses, Src);
	2311	PrimaryDiag := nil;
	2312	for i := 0 to Src.Count - 1 do
	2313	begin
	2314	SrcDiagnosis := TPCEDiag(Src.Objects[i]);
	2315	MatchIndex := MatchItem(FDiagnoses, SrcDiagnosis);
	2316	if MatchIndex > -1 then //found in fdiagnoses
	2317	begin
	2318	CurDiagnosis := TPCEDiag(FDiagnoses.Items[MatchIndex]);
	2319	if ((SrcDiagnosis.Primary <> CurDiagnosis.Primary) or
	2320	(SrcDiagnosis.Comment <> CurDiagnosis.Comment) or
	2321	(SrcDiagnosis.AddProb <> CurDiagnosis.Addprob)) then
	2322	begin
	2323	CurDiagnosis.Primary := SrcDiagnosis.Primary;
	2324	CurDiagnosis.Comment := SrcDiagnosis.Comment;
	2325	CurDiagnosis.AddProb := SrcDiagnosis.AddProb;
	2326	CurDiagnosis.FSend := True;
	2327	end;
	2328	end else
	2329	begin
	2330	CurDiagnosis := TPCEDiag.Create;
	2331	CurDiagnosis.Assign(SrcDiagnosis);
	2332	CurDiagnosis.FSend := True;
	2333	FDiagnoses.Add(CurDiagnosis);
	2334	end; {if MatchIndex}
	2335	if(CurDiagnosis.Primary and (not assigned(PrimaryDiag))) then
	2336	PrimaryDiag := CurDiagnosis;
	2337	end; {for}
	2338	if(assigned(PrimaryDiag)) then
	2339	begin
	2340	for i := 0 to FDiagnoses.Count - 1 do
	2341	begin
	2342	CurDiagnosis := TPCEDiag(FDiagnoses[i]);
	2343	if(CurDiagnosis.Primary) and (CurDiagnosis <> PrimaryDiag) then
	2344	begin
	2345	CurDiagnosis.Primary := FALSE;
	2346	CurDiagnosis.FSend := True;
	2347	end;
	2348	end;
	2349	end;
	2350	end;
	2351
	2352	procedure TPCEData.SetProcedures(Src: TStrings; FromForm: boolean = TRUE);
	2353	{ load Procedures for this encounter into TPCEProc records, assumes all Procedures for the
	2354	encounter will be listed in Src and marks those that are not in Src for deletion }
	2355	var
	2356	i, MatchIndex: Integer;
	2357	SrcProcedure, CurProcedure, OldProcedure: TPCEProc;
	2358	begin
	2359	if FromForm then MarkDeletions(FProcedures, Src);
	2360	for i := 0 to Src.Count - 1 do
	2361	begin
	2362	SrcProcedure := TPCEProc(Src.Objects[i]);
	2363	MatchIndex := MatchItem(FProcedures, SrcProcedure);
	2364	if MatchIndex > -1 then
	2365	begin
	2366	CurProcedure := TPCEProc(FProcedures.Items[MatchIndex]);
	2367	(* if (SrcProcedure.Provider <> CurProcedure.Provider) then
	2368	begin
	2369	OldProcedure := TPCEProc.Create;
	2370	OldProcedure.Assign(CurProcedure);
	2371	OldProcedure.FDelete := TRUE;
	2372	OldProcedure.FSend := TRUE;
	2373	FProcedures.Add(OldProcedure);
	2374	end;*)
	2375	if (SrcProcedure.Quantity <> CurProcedure.Quantity) or
	2376	(SrcProcedure.Provider <> CurProcedure.Provider) or
	2377	(Curprocedure.Comment <> SrcProcedure.Comment) or
	2378	(Curprocedure.Modifiers <> SrcProcedure.Modifiers)then
	2379	begin
	2380	OldProcedure := TPCEProc.Create;
	2381	OldProcedure.Assign(CurProcedure);
	2382	OldProcedure.FDelete := TRUE;
	2383	OldProcedure.FSend := TRUE;
	2384	FProcedures.Add(OldProcedure);
	2385	CurProcedure.Quantity := SrcProcedure.Quantity;
	2386	CurProcedure.Provider := SrcProcedure.Provider;
	2387	CurProcedure.Comment := SrcProcedure.Comment;
	2388	CurProcedure.Modifiers := SrcProcedure.Modifiers;
	2389	CurProcedure.FSend := True;
	2390	end;
	2391	end else
	2392	begin
	2393	CurProcedure := TPCEProc.Create;
	2394	CurProcedure.Assign(SrcProcedure);
	2395	CurProcedure.FSend := True;
	2396	FProcedures.Add(CurProcedure);
	2397	end; {if MatchIndex}
	2398	end; {for}
	2399	end;
	2400
	2401
	2402
	2403	procedure TPCEData.SetImmunizations(Src: TStrings; FromForm: boolean = TRUE);
	2404	{ load Immunizations for this encounter into TPCEImm records, assumes all Immunizations for the
	2405	encounter will be listed in Src and marks those that are not in Src for deletion }
	2406	var
	2407	i, MatchIndex: Integer;
	2408	SrcImmunization, CurImmunization: TPCEImm;
	2409	begin
	2410	if FromForm then MarkDeletions(FImmunizations, Src);
	2411	for i := 0 to Src.Count - 1 do
	2412	begin
	2413	SrcImmunization := TPCEImm(Src.Objects[i]);
	2414	MatchIndex := MatchItem(FImmunizations, SrcImmunization);
	2415	if MatchIndex > -1 then
	2416	begin
	2417	CurImmunization := TPCEImm(FImmunizations.Items[MatchIndex]);
	2418
	2419	//set null strings to NoPCEValue
	2420	if SrcImmunization.Series = '' then SrcImmunization.Series := NoPCEValue;
	2421	if SrcImmunization.Reaction = '' then SrcImmunization.Reaction := NoPCEValue;
	2422	if CurImmunization.Series = '' then CurImmunization.Series := NoPCEValue;
	2423	if CurImmunization.Reaction = '' then CurImmunization.Reaction := NoPCEValue;
	2424
	2425	// if (SrcImmunization.Provider <> CurImmunization.Provider) or
	2426	if(SrcImmunization.Series <> CurImmunization.Series) or
	2427	(SrcImmunization.Reaction <> CurImmunization.Reaction) or
	2428	(SrcImmunization.Refused <> CurImmunization.Refused) or
	2429	(SrcImmunization.Contraindicated <> CurImmunization.Contraindicated) or
	2430	(CurImmunization.Comment <> SrcImmunization.Comment)then
	2431	begin
	2432	// CurImmunization.Provider := SrcImmunization.Provider;
	2433	CurImmunization.Series := SrcImmunization.Series;
	2434	CurImmunization.Reaction := SrcImmunization.Reaction;
	2435	CurImmunization.Refused := SrcImmunization.Refused;
	2436	CurImmunization.Contraindicated := SrcImmunization.Contraindicated;
	2437	CurImmunization.Comment := SrcImmunization.Comment;
	2438	CurImmunization.FSend := True;
	2439	end;
	2440	end else
	2441	begin
	2442	CurImmunization := TPCEImm.Create;
	2443	CurImmunization.Assign(SrcImmunization);
	2444	CurImmunization.FSend := True;
	2445	FImmunizations.Add(CurImmunization);
	2446	end; {if MatchIndex}
	2447	end; {for}
	2448	end;
	2449
	2450	procedure TPCEData.SetSkinTests(Src: TStrings; FromForm: boolean = TRUE);
	2451	{ load SkinTests for this encounter into TPCESkin records, assumes all SkinTests for the
	2452	encounter will be listed in Src and marks those that are not in Src for deletion }
	2453	var
	2454	i, MatchIndex: Integer;
	2455	SrcSkinTest, CurSkinTest: TPCESkin;
	2456	begin
	2457	if FromForm then MarkDeletions(FSKinTests, Src);
	2458	for i := 0 to Src.Count - 1 do
	2459	begin
	2460	SrcSkinTest := TPCESkin(Src.Objects[i]);
	2461	MatchIndex := MatchItem(FSKinTests, SrcSkinTest);
	2462	if MatchIndex > -1 then
	2463	begin
	2464	CurSkinTest := TPCESKin(FSkinTests.Items[MatchIndex]);
	2465	if CurSkinTest.Results = '' then CurSkinTest.Results := NoPCEValue;
	2466	if SrcSkinTest.Results = '' then SrcSkinTest.Results := NoPCEValue;
	2467	// if (SrcSkinTest.Provider <> CurSkinTest.Provider) or
	2468	if(SrcSkinTest.Results <> CurSkinTest.Results) or
	2469	(SrcSkinTest.Reading <> CurSkinTest.Reading) or
	2470	(CurSkinTest.Comment <> SrcSkinTest.Comment) then
	2471	begin
	2472	// CurSkinTest.Provider := SrcSkinTest.Provider;
	2473	CurSkinTest.Results := SrcSkinTest.Results;
	2474	CurSkinTest.Reading := SrcSkinTest.Reading;
	2475	CurSkinTest.Comment := SrcSkinTest.Comment;
	2476	CurSkinTest.FSend := True;
	2477	end;
	2478	end else
	2479	begin
	2480	CurSKinTest := TPCESkin.Create;
	2481	CurSkinTest.Assign(SrcSkinTest);
	2482	CurSkinTest.FSend := True;
	2483	FSkinTests.Add(CurSkinTest);
	2484	end; {if MatchIndex}
	2485	end; {for}
	2486	end;
	2487
	2488	procedure TPCEData.SetPatientEds(Src: TStrings; FromForm: boolean = TRUE);
	2489	var
	2490	i, MatchIndex: Integer;
	2491	SrcPatientEd, CurPatientEd: TPCEPat;
	2492	begin
	2493	if FromForm then MarkDeletions(FPatientEds, Src);
	2494	for i := 0 to Src.Count - 1 do
	2495	begin
	2496	SrcPatientEd := TPCEPat(Src.Objects[i]);
	2497	MatchIndex := MatchItem(FPatientEds, SrcPatientEd);
	2498	if MatchIndex > -1 then
	2499	begin
	2500	CurPatientEd := TPCEPat(FPatientEds.Items[MatchIndex]);
	2501
	2502	if CurPatientEd.level = '' then CurPatientEd.level := NoPCEValue;
	2503	if SrcPatientEd.level = '' then SrcPatientEd.level := NoPCEValue;
	2504	// if (SrcPatientEd.Provider <> CurPatientEd.Provider) or
	2505	if(SrcPatientEd.Level <> CurPatientEd.Level) or
	2506	(CurPatientEd.Comment <> SrcPatientEd.Comment) then
	2507	begin
	2508	// CurPatientEd.Provider := SrcPatientEd.Provider;
	2509	CurPatientEd.Level := SrcPatientEd.Level;
	2510	CurPatientEd.Comment := SrcPatientEd.Comment;
	2511	CurPatientEd.FSend := True;
	2512	end;
	2513	end else
	2514	begin
	2515	CurPatientEd := TPCEPat.Create;
	2516	CurPatientEd.Assign(SrcPatientEd);
	2517	CurPatientEd.FSend := True;
	2518	FPatientEds.Add(CurPatientEd);
	2519	end; {if MatchIndex}
	2520	end; {for}
	2521	end;
	2522
	2523
	2524	procedure TPCEData.SetHealthFactors(Src: TStrings; FromForm: boolean = TRUE);
	2525
	2526	var
	2527	i, MatchIndex: Integer;
	2528	SrcHealthFactor, CurHealthFactor: TPCEHealth;
	2529	begin
	2530	if FromForm then MarkDeletions(FHealthFactors, Src);
	2531	for i := 0 to Src.Count - 1 do
	2532	begin
	2533	SrcHealthFactor := TPCEHealth(Src.Objects[i]);
	2534	MatchIndex := MatchItem(FHealthFactors, SrcHealthFactor);
	2535	if MatchIndex > -1 then
	2536	begin
	2537	CurHealthFactor := TPCEHealth(FHealthFactors.Items[MatchIndex]);
	2538
	2539	if CurHealthFactor.level = '' then CurHealthFactor.level := NoPCEValue;
	2540	if SrcHealthFactor.level = '' then SrcHealthFactor.level := NoPCEValue;
	2541	// if (SrcHealthFactor.Provider <> CurHealthFactor.Provider) or
	2542	if(SrcHealthFactor.Level <> CurHealthFactor.Level) or
	2543	(CurHealthFactor.Comment <> SrcHealthFactor.Comment) then
	2544	begin
	2545	// CurHealthFactor.Provider := SrcHealthFactor.Provider;
	2546	CurHealthFactor.Level := SrcHealthFactor.Level;
	2547	CurHealthFactor.Comment := SrcHealthFactor.Comment;
	2548	CurHealthFactor.FSend := True;
	2549	end;
	2550	if(SrcHealthFactor.GecRem <> CurHealthFactor.GecRem) then
	2551	CurHealthFactor.GecRem := SrcHealthFactor.GecRem;
	2552	end else
	2553	begin
	2554	CurHealthFactor := TPCEHealth.Create;
	2555	CurHealthFactor.Assign(SrcHealthFactor);
	2556	CurHealthFactor.FSend := True;
	2557	CurHealthFactor.GecRem := SrcHealthFactor.GecRem;
	2558	FHealthFactors.Add(CurHealthFactor);
	2559	end; {if MatchIndex}
	2560	end; {for}
	2561	end;
	2562
	2563
	2564	procedure TPCEData.SetExams(Src: TStrings; FromForm: boolean = TRUE);
	2565
	2566	var
	2567	i, MatchIndex: Integer;
	2568	SrcExam, CurExam: TPCEExams;
	2569	begin
	2570	if FromForm then MarkDeletions(FExams, Src);
	2571	for i := 0 to Src.Count - 1 do
	2572	begin
	2573	SrcExam := TPCEExams(Src.Objects[i]);
	2574	MatchIndex := MatchItem(FExams, SrcExam);
	2575	if MatchIndex > -1 then
	2576	begin
	2577	CurExam := TPCEExams(FExams.Items[MatchIndex]);
	2578	if CurExam.Results = '' then CurExam.Results := NoPCEValue;
	2579	if SrcExam.Results = '' then SrcExam.Results := NoPCEValue;
	2580	// if (SrcExam.Provider <> CurExam.Provider) or
	2581	if(SrcExam.Results <> CurExam.Results) or
	2582	(CurExam.Comment <> SrcExam.Comment) then
	2583	begin
	2584	// CurExam.Provider := SrcExam.Provider;
	2585	CurExam.Results := SrcExam.Results;
	2586	CurExam.Comment := SrcExam.Comment;
	2587	CurExam.Fsend := True;
	2588	end;
	2589	end else
	2590	begin
	2591	CurExam := TPCEExams.Create;
	2592	CurExam.Assign(SrcExam);
	2593	CurExam.FSend := True;
	2594	FExams.Add(CurExam);
	2595	end; {if MatchIndex}
	2596	end; {for}
	2597	end;
	2598
	2599
	2600	procedure TPCEData.SetVisitType(Value: TPCEProc);
	2601	var
	2602	VisitDelete: TPCEProc;
	2603	begin
	2604	if (not FVisitType.Match(Value)) or
	2605	(FVisitType.Modifiers <> Value.Modifiers) then {causes CPT delete/re-add}
	2606	begin
	2607	if FVisitType.Code <> '' then // add old visit to procedures for deletion
	2608	begin
	2609	VisitDelete := TPCEProc.Create;
	2610	VisitDelete.Assign(FVisitType);
	2611	VisitDelete.FDelete := True;
	2612	VisitDelete.FSend := True;
	2613	FProcedures.Add(VisitDelete);
	2614	end;
	2615	FVisitType.Assign(Value);
	2616	FVisitType.Quantity := 1;
	2617	FVisitType.FSend := True;
	2618	end;
	2619	end;
	2620
	2621	procedure TPCEData.SetSCRelated(Value: Integer);
	2622	begin
	2623	if Value <> FSCRelated then
	2624	begin
	2625	FSCRelated := Value;
	2626	FSCChanged := True;
	2627	end;
	2628	end;
	2629
	2630	procedure TPCEData.SetAORelated(Value: Integer);
	2631	begin
	2632	if Value <> FAORelated then
	2633	begin
	2634	FAORelated := Value;
	2635	FSCChanged := True;
	2636	end;
	2637	end;
	2638
	2639	procedure TPCEData.SetIRRelated(Value: Integer);
	2640	begin
	2641	if Value <> FIRRelated then
	2642	begin
	2643	FIRRelated := Value;
	2644	FSCChanged := True;
	2645	end;
	2646	end;
	2647
	2648	procedure TPCEData.SetECRelated(Value: Integer);
	2649	begin
	2650	if Value <> FECRelated then
	2651	begin
	2652	FECRelated := Value;
	2653	FSCChanged := True;
	2654	end;
	2655	end;
	2656
	2657	procedure TPCEData.SetMSTRelated(Value: Integer);
	2658	begin
	2659	if Value <> FMSTRelated then
	2660	begin
	2661	FMSTRelated := Value;
	2662	FSCChanged := True;
	2663	end;
	2664	end;
	2665
	2666	procedure TPCEData.SetHNCRelated(Value: Integer);
	2667	begin
	2668	// if HNCOK and (Value <> FHNCRelated) then
	2669	if Value <> FHNCRelated then
	2670	begin
	2671	FHNCRelated := Value;
	2672	FSCChanged := True;
	2673	end;
	2674	end;
	2675
	2676	procedure TPCEData.SetCVRelated(Value: Integer);
	2677	begin
	2678	if (Value <> FCVRelated) then
	2679	begin
	2680	FCVRelated := Value;
	2681	FSCChanged := True;
	2682	end;
	2683	end;
	2684
	2685	procedure TPCEData.SetEncUseCurr(Value: Boolean);
	2686	begin
	2687	FEncUseCurr := Value;
	2688	if FEncUseCurr then
	2689	begin
	2690	FEncDateTime := Encounter.DateTime;
	2691	FEncLocation := Encounter.Location;
	2692	//need to add to full list of providers
	2693	FEncSvcCat := Encounter.VisitCategory;
	2694	FStandAlone := Encounter.StandAlone;
	2695	FStandAloneLoaded := TRUE;
	2696	//FCPTRequired := Encounter.StandAlone;
	2697	FEncInpatient := Encounter.Inpatient;
	2698	//if FEncInpatient then FCPTRequired := False;
	2699	//SetDefaultProvider(FProviders, FEncLocation, FNoteIEN, PersonClassDate);
	2700	end else
	2701	begin
	2702	FEncDateTime := 0;
	2703	FEncLocation := 0;
	2704	FStandAlone := FALSE;
	2705	FStandAloneLoaded := FALSE;
	2706	FProviders.PrimaryIdx := -1;
	2707	FEncSvcCat := 'A';
	2708	//FCPTRequired := False;
	2709	FEncInpatient := False;
	2710	end;
	2711	//
	2712	SetRPCEncLocation(FEncLocation);
	2713	// SetRPCEncDateTime(FEncDateTime);
	2714	end;
	2715
	2716	function TPCEData.StrDiagnoses: string;
	2717	{ returns the list of diagnoses for this encounter as a single comma delimited string }
	2718	var
	2719	i: Integer;
	2720	begin
	2721	Result := '';
	2722	with FDiagnoses do for i := 0 to Count - 1 do with TPCEDiag(Items[i]) do
	2723	if not FDelete then
	2724	Result := Result + GetPCEDataText(pdcDiag, Code, Category, Narrative, Primary) + ', ';
	2725	if Length(Result) > 0 then Result := PCEDataCatText[pdcDiag] + Copy(Result, 1, Length(Result) - 2);
	2726	end;
	2727
	2728	function TPCEData.StrProcedures: string;
	2729	{ returns the list of procedures for this encounter as a single comma delimited string }
	2730	var
	2731	i: Integer;
	2732	begin
	2733	Result := '';
	2734	with FProcedures do for i := 0 to Count - 1 do with TPCEProc(Items[i]) do
	2735	if not FDelete then
	2736	Result := Result + GetPCEDataText(pdcProc, Code, Category, Narrative, FALSE, Quantity) +
	2737	ModText + ', ';
	2738	if Length(Result) > 0 then Result := PCEDataCatText[pdcProc] + Copy(Result, 1, Length(Result) - 2);
	2739	end;
	2740
	2741	function TPCEData.StrImmunizations: string;
	2742	{ returns the list of Immunizations for this encounter as a single comma delimited string }
	2743	var
	2744	i: Integer;
	2745	begin
	2746	Result := '';
	2747	with FImmunizations do for i := 0 to Count - 1 do with TPCEImm(Items[i]) do
	2748	if not FDelete then
	2749	Result := Result + GetPCEDataText(pdcImm, Code, Category, Narrative) + ', ';
	2750	if Length(Result) > 0 then Result := PCEDataCatText[pdcImm] + Copy(Result, 1, Length(Result) - 2);
	2751	end;
	2752
	2753
	2754	function TPCEData.StrSkinTests: string;
	2755	{ returns the list of Immunizations for this encounter as a single comma delimited string }
	2756	var
	2757	i: Integer;
	2758	begin
	2759	Result := '';
	2760	with FSkinTests do for i := 0 to Count - 1 do with TPCESkin(Items[i]) do
	2761	if not FDelete then
	2762	Result := Result + GetPCEDataText(pdcSkin, Code, Category, Narrative) + ', ';
	2763	if Length(Result) > 0 then Result := PCEDataCatText[pdcSkin] + Copy(Result, 1, Length(Result) - 2);
	2764	end;
	2765
	2766	function TPCEData.StrPatientEds: string;
	2767	var
	2768	i: Integer;
	2769	begin
	2770	Result := '';
	2771	with FPatientEds do for i := 0 to Count - 1 do with TPCEPat(Items[i]) do
	2772	if not FDelete then
	2773	Result := Result + GetPCEDataText(pdcPED, Code, Category, Narrative) + ', ';
	2774	if Length(Result) > 0 then Result := PCEDataCatText[pdcPED] + Copy(Result, 1, Length(Result) - 2);
	2775	end;
	2776
	2777	function TPCEData.StrHealthFactors: string;
	2778	var
	2779	i: Integer;
	2780	begin
	2781	Result := '';
	2782	with FHealthFactors do for i := 0 to Count - 1 do with TPCEHealth(Items[i]) do
	2783	if not FDelete then
	2784	Result := Result + GetPCEDataText(pdcHF, Code, Category, Narrative) + ', ';
	2785	if Length(Result) > 0 then Result := PCEDataCatText[pdcHF] + Copy(Result, 1, Length(Result) - 2);
	2786	end;
	2787
	2788	function TPCEData.StrExams: string;
	2789	var
	2790	i: Integer;
	2791	begin
	2792	Result := '';
	2793	with FExams do for i := 0 to Count - 1 do with TPCEExams(Items[i]) do
	2794	if not FDelete then
	2795	Result := Result + GetPCEDataText(pdcExam, Code, Category, Narrative) + ', ';
	2796	if Length(Result) > 0 then Result := PCEDataCatText[pdcExam] + Copy(Result, 1, Length(Result) - 2);
	2797	end;
	2798
	2799	function TPCEData.StrVisitType(const ASCRelated, AAORelated, AIRRelated,
	2800	AECRelated, AMSTRelated, AHNCRelated, ACVRelated: Integer): string;
	2801	{ returns as a string the type of encounter (according to CPT) & related contitions treated }
	2802
	2803	procedure AddTxt(txt: string);
	2804	begin
	2805	if(Result <> '') then
	2806	Result := Result + ',';
	2807	Result := Result + ' ' + txt;
	2808	end;
	2809
	2810	begin
	2811	Result := '';
	2812	if ASCRelated = SCC_YES then AddTxt('Service Connected Condition');
	2813	if AAORelated = SCC_YES then AddTxt('Agent Orange Exposure');
	2814	if AIRRelated = SCC_YES then AddTxt('Ionizing Radiation Exposure');
	2815	if AECRelated = SCC_YES then AddTxt('Environmental Contaminants');
	2816	if AMSTRelated = SCC_YES then AddTxt('MST');//'Military Sexual Trauma';
	2817	// if HNCOK and (AHNCRelated = SCC_YES) then AddTxt('Head and/or Neck Cancer');
	2818	if AHNCRelated = SCC_YES then AddTxt('Head and/or Neck Cancer');
	2819	if ACVRelated = SCC_YES then AddTxt('Combat Veteran Related');
	2820	if Length(Result) > 0 then Result := ' related to: ' + Result;
	2821	// Result := Trim(Result);
	2822	end;
	2823
	2824	function TPCEData.StrVisitType: string;
	2825	{ returns as a string the type of encounter (according to CPT) & related contitions treated }
	2826	begin
	2827	Result := '';
	2828	with FVisitType do
	2829	begin
	2830	Result := GetPCEDataText(pdcVisit, Code, Category, Narrative);
	2831	if Length(ModText) > 0 then Result := Result + ModText + ', ';
	2832	end;
	2833	Result := Trim(Result + StrVisitType(FSCRelated, FAORelated, FIRRelated,
	2834	FECRelated, FMSTRelated, FHNCRelated, FCVRelated));
	2835	end;
	2836
	2837	function TPCEData.StandAlone: boolean;
	2838	var
	2839	Sts: integer;
	2840
	2841	begin
	2842	if(not FStandAloneLoaded) and ((FNoteIEN > 0) or ((FEncLocation > 0) and (FEncDateTime > 0))) then
	2843	begin
	2844	Sts := HasVisit(FNoteIEN, FEncLocation, FEncDateTime);
	2845	FStandAlone := (Sts <> 1);
	2846	if(Sts >= 0) then
	2847	FStandAloneLoaded := TRUE;
	2848	end;
	2849	Result := FStandAlone;
	2850	end;
	2851
	2852	function TPCEData.getDocCount: Integer;
	2853	begin
	2854	rESULT := 1;
	2855	// result := DocCount(vISIT);
	2856	end;
	2857
	2858	{function TPCEItem.MatchProvider(AnItem: TPCEItem): Boolean;
	2859	begin
	2860	Result := False;
	2861	if (Provider = AnItem.Provider) then Result := True;
	2862	end;
	2863	}
	2864	function TPCEItem.MatchProvider(AnItem: TPCEItem): Boolean;
	2865	begin
	2866	Result := False;
	2867	if (Provider = AnItem.Provider) then Result := True;
	2868	end;
	2869
	2870	function TPCEData.GetHasData: Boolean;
	2871	begin
	2872	result := True;
	2873	if ((FDiagnoses.count = 0)
	2874	and (FProcedures.count = 0)
	2875	and (FImmunizations.count = 0)
	2876	and (FSkinTests.count = 0)
	2877	and (FPatientEds.count = 0)
	2878	and (FHealthFactors.count = 0)
	2879	and (fExams.count = 0) and
	2880	(FvisitType.Quantity = 0))then
	2881	result := False;
	2882	end;
	2883
	2884	procedure TPCEData.CopyPCEData(Dest: TPCEData);
	2885	begin
	2886	Dest.Clear;
	2887	Dest.FEncDateTime := FEncDateTime;
	2888	Dest.FNoteDateTime := FNoteDateTime;
	2889	Dest.FEncLocation := FEncLocation;
	2890	Dest.FEncSvcCat := FEncSvcCat;
	2891	Dest.FEncInpatient := FEncInpatient;
	2892	Dest.FStandAlone := FStandAlone;
	2893	Dest.FStandAloneLoaded := FStandAloneLoaded;
	2894	Dest.FEncUseCurr := FEncUseCurr;
	2895	Dest.FSCChanged := FSCChanged;
	2896	Dest.FSCRelated := FSCRelated;
	2897	Dest.FAORelated := FAORelated;
	2898	Dest.FIRRelated := FIRRelated;
	2899	Dest.FECRelated := FECRelated;
	2900	Dest.FMSTRelated := FMSTRelated;
	2901	Dest.FHNCRelated := FHNCRelated;
	2902	Dest.FCVRelated := FCVRelated;
	2903	FVisitType.CopyProc(Dest.VisitType);
	2904	Dest.FProviders.Assign(FProviders);
	2905
	2906	CopyPCEItems(FDiagnoses, Dest.FDiagnoses, TPCEDiag);
	2907	CopyPCEItems(FProcedures, Dest.FProcedures, TPCEProc);
	2908	CopyPCEItems(FImmunizations, Dest.FImmunizations, TPCEImm);
	2909	CopyPCEItems(FSkinTests, Dest.FSkinTests, TPCESkin);
	2910	CopyPCEItems(FPatientEds, Dest.FPatientEds, TPCEPat);
	2911	CopyPCEItems(FHealthFactors, Dest.FHealthFactors, TPCEHealth);
	2912	CopyPCEItems(FExams, Dest.FExams, TPCEExams);
	2913
	2914	Dest.FNoteTitle := FNoteTitle;
	2915	Dest.FNoteIEN := FNoteIEN;
	2916	Dest.FParent := FParent;
	2917	Dest.FHistoricalLocation := FHistoricalLocation;
	2918	end;
	2919
	2920	function TPCEData.NeededPCEData: tRequiredPCEDataTypes;
	2921	var
	2922	EC: TSCConditions;
	2923	NeedSC: boolean;
	2924	TmpLst: TStringList;
	2925
	2926	begin
	2927	Result := [];
	2928	if(not FutureEncounter(Self)) then
	2929	begin
	2930	// if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone) or CPTRequiredForNote(FNoteIEN)) then
	2931	if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone)) then
	2932	begin
	2933	if(fdiagnoses.count <= 0) then
	2934	Include(Result, ndDiag);
	2935	if((fprocedures.count <= 0) and (fVisitType.Code = '')) then
	2936	begin
	2937	TmpLst := TStringList.Create;
	2938	try
	2939	GetHasCPTList(TmpLst);
	2940	if(not DataHasCPTCodes(TmpLst)) then
	2941	Include(Result, ndProc);
	2942	finally
	2943	TmpLst.Free;
	2944	end;
	2945	end;
	2946	if(RequireExposures(FNoteIEN, FNoteTitle)) then
	2947	begin
	2948	NeedSC := FALSE;
	2949	EC := EligbleConditions;
	2950	if (EC.SCAllow and (SCRelated = SCC_NA)) then
	2951	NeedSC := TRUE
	2952	else if(SCRelated <> SCC_YES) then //if screlated = yes, the others are not asked.
	2953	begin
	2954	if(EC.AOAllow and (AORelated = SCC_NA)) then NeedSC := TRUE
	2955	else if(EC.IRAllow and (IRRelated = SCC_NA)) then NeedSC := TRUE
	2956	else if(EC.ECAllow and (ECRelated = SCC_NA)) then NeedSC := TRUE
	2957	end;
	2958	if(EC.MSTAllow and (MSTRelated = SCC_NA)) then NeedSC := TRUE;
	2959	// if HNCOK and (EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE;
	2960	if(EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE;
	2961	if(EC.CVAllow and (CVRelated = SCC_NA)) then NeedSC := TRUE;
	2962	if(NeedSC) then
	2963	Include(Result, ndSC);
	2964	end;
	2965	(* if(Result = []) and (FNoteIEN > 0) then // ** block removed in v19.1 {RV} **
	2966	ClearCPTRequired(FNoteIEN);*)
	2967	end;
	2968	end;
	2969	end;
	2970
	2971
	2972	function TPCEData.OK2SignNote: boolean;
	2973	var
	2974	Req: tRequiredPCEDataTypes;
	2975	msg: string;
	2976	Asked, DoAsk, Primary, Needed: boolean;
	2977	Outpatient, First, DoSave, NeedSave, Done: boolean;
	2978	Ans: integer;
	2979	Flags: word;
	2980	Ask: TAskPCE;
	2981
	2982	procedure Add(Typ: tRequiredPCEDataType; txt: string);
	2983	begin
	2984	if(Typ in Req) then
	2985	msg := msg + txt + CRLF;
	2986	end;
	2987
	2988	begin
	2989	if not CanEditPCE(Self) then
	2990	begin
	2991	Result := TRUE;
	2992	exit;
	2993	end;
[460]	2994	if IsNonCountClinic(FEncLocation) then
	2995	begin
	2996	Result := TRUE;
	2997	exit;
	2998	end;
[459]	2999	if IsCancelOrNoShow(NoteIEN) then
	3000	begin
	3001	Result := TRUE;
	3002	exit;
	3003	end;
	3004	Ask := GetAskPCE(FEncLocation);
	3005	if(Ask = apNever) or (Ask = apDisable) then
	3006	Result := TRUE
	3007	else
	3008	begin
	3009	DoSave := FALSE;
	3010	try
	3011	Asked := FALSE;
	3012	First := TRUE;
	3013	Outpatient := ((FEncSvcCat = 'A') or (FEncSvcCat = 'I') or (FEncSvcCat = 'T'));
	3014	repeat
	3015	Result := TRUE;
	3016	Done := TRUE;
	3017	Req := NeededPCEData;
	3018	Needed := (Req <> []);
	3019	if(First) then
	3020	begin
	3021	if Needed and (not Outpatient) then
	3022	OutPatient := TRUE;
	3023	if((Ask = apPrimaryAlways) or Needed or
	3024	((Ask = apPrimaryOutpatient) and Outpatient)) then
	3025	begin
	3026	if(Providers.PrimaryIdx < 0) then
	3027	begin
	3028	NoPrimaryPCEProvider(FProviders, Self);
	3029	if(not DoSave) then
	3030	DoSave := (Providers.PrimaryIdx >= 0);
	3031	if(DoSave and (FProviders.PendingIEN(FALSE) <> 0) and
	3032	(FProviders.IndexOfProvider(IntToStr(FProviders.PendingIEN(FALSE))) < 0)) then
	3033	FProviders.AddProvider(IntToStr(FProviders.PendingIEN(FALSE)), FProviders.PendingName(FALSE), FALSE);
	3034	end;
	3035	end;
	3036	First := FALSE;
	3037	end;
	3038	Primary := (Providers.PrimaryIEN = User.DUZ);
	3039	case Ask of
	3040	apPrimaryOutpatient: DoAsk := (Primary and Outpatient);
	3041	apPrimaryAlways: DoAsk := Primary;
	3042	apNeeded: DoAsk := Needed;
	3043	apOutpatient: DoAsk := Outpatient;
	3044	apAlways: DoAsk := TRUE;
	3045	else
	3046	{ apPrimaryNeeded } DoAsk := (Primary and Needed);
	3047	end;
	3048	if(DoAsk) then
	3049	begin
	3050	if(Asked and ((not Needed) or (not Primary))) then
	3051	exit;
	3052	if(Needed) then
	3053	begin
	3054	msg := TX_NEED1;
	3055	Add(ndDiag, TX_NEED_DIAG);
	3056	Add(ndProc, TX_NEED_PROC);
	3057	Add(ndSC, TX_NEED_SC);
	3058	if(Primary and ForcePCEEntry(FEncLocation)) then
	3059	begin
	3060	Flags := MB_OKCANCEL;
	3061	msg := msg + CRLF + TX_NEED3;
	3062	end
	3063	else
	3064	begin
	3065	if(Primary) then
	3066	Flags := MB_YESNOCANCEL
	3067	else
	3068	Flags := MB_YESNO;
	3069	msg := msg + CRLF + TX_NEED2;
	3070	end;
	3071	Flags := Flags + MB_ICONWARNING;
	3072	end
	3073	else
	3074	begin
	3075	Flags := MB_YESNO + MB_ICONQUESTION;
	3076	msg := TX_NEED2;
	3077	end;
	3078	Ans := InfoBox(msg, TX_NEED_T, Flags);
	3079	if(Ans = ID_CANCEL) then
	3080	begin
	3081	Result := FALSE;
	3082	InfoBox(TX_NEEDABORT, TX_NEED_T, MB_OK);
	3083	exit;
	3084	end;
	3085	Result := (Ans = ID_NO);
	3086	if(not Result) then
	3087	begin
	3088	if(not MissingProviderInfo(Self)) then
	3089	begin
	3090	NeedSave := UpdatePCE(Self, FALSE);
	3091	if(not DoSave) then
	3092	DoSave := NeedSave;
	3093	FUpdated := TRUE;
	3094	end;
	3095	Done := frmFrame.Closing;
	3096	Asked := TRUE;
	3097	end;
	3098	end;
	3099	until(Done);
	3100	finally
	3101	if(DoSave) then
	3102	Save;
	3103	end;
	3104	end;
	3105	end;
	3106
	3107	procedure TPCEData.AddStrData(List: TStrings);
	3108
	3109	procedure Add(Txt: string);
	3110	begin
	3111	if(length(Txt) > 0) then List.Add(Txt);
	3112	end;
	3113
	3114	begin
	3115	Add(StrVisitType);
	3116	Add(StrDiagnoses);
	3117	Add(StrProcedures);
	3118	Add(StrImmunizations);
	3119	Add(StrSkinTests);
	3120	Add(StrPatientEds);
	3121	Add(StrHealthFactors);
	3122	Add(StrExams);
	3123	end;
	3124
	3125	procedure TPCEData.AddVitalData(Data, List: TStrings);
	3126	var
	3127	i: integer;
	3128
	3129	begin
	3130	for i := 0 to Data.Count-1 do
	3131	List.Add(FormatVitalForNote(Data[i]));
	3132	end;
	3133
	3134	function TPCEData.PersonClassDate: TFMDateTime;
	3135	begin
	3136	if(FEncSvcCat = 'H') then
	3137	Result := FMToday
	3138	else
	3139	Result := FEncDateTime; //Encounter.DateTime;
	3140	end;
	3141
	3142	function TPCEData.VisitDateTime: TFMDateTime;
	3143	begin
	3144	if(IsSecondaryVisit) then
	3145	Result := FNoteDateTime
	3146	else
	3147	Result := FEncDateTime;
	3148	end;
	3149
	3150	function TPCEData.IsSecondaryVisit: boolean;
	3151	begin
	3152	Result := ((FEncSvcCat = 'H') and (FNoteDateTime > 0) and (FEncInpatient));
	3153	end;
	3154
	3155	function TPCEData.NeedProviderInfo: boolean;
	3156	var
	3157	i: integer;
	3158	TmpLst: TStringList;
	3159
	3160	begin
	3161	if(FProviders.PrimaryIdx < 0) then
	3162	begin
	3163	Result := AutoCheckout(FEncLocation);
	3164	if not Result then
	3165	begin
	3166	for i := 0 to FDiagnoses.Count - 1 do
	3167	begin
	3168	if not TPCEDiag(FDiagnoses[i]).FDelete then
	3169	begin
	3170	Result := TRUE;
	3171	break;
	3172	end;
	3173	end;
	3174	end;
	3175	if not Result then
	3176	begin
	3177	for i := 0 to FProcedures.Count - 1 do
	3178	begin
	3179	if not TPCEProc(FProcedures[i]).FDelete then
	3180	begin
	3181	Result := TRUE;
	3182	break;
	3183	end;
	3184	end;
	3185	end;
	3186	if not Result then
	3187	begin
	3188	for i := 0 to FProviders.Count - 1 do
	3189	begin
	3190	if not FProviders[i].Delete then
	3191	begin
	3192	Result := TRUE;
	3193	break;
	3194	end;
	3195	end;
	3196	end;
	3197	if not Result then
	3198	begin
	3199	TmpLst := TStringList.Create;
	3200	try
	3201	GetHasCPTList(TmpLst);
	3202	if(DataHasCPTCodes(TmpLst)) then
	3203	Result := TRUE;
	3204	finally
	3205	TmpLst.Free;
	3206	end;
	3207	end;
	3208	end
	3209	else
	3210	Result := FALSE;
	3211	end;
	3212
	3213	procedure TPCEData.GetHasCPTList(AList: TStrings);
	3214
	3215	procedure AddList(List: TList);
	3216	var
	3217	i: integer;
	3218	tmp: string;
	3219
	3220	begin
	3221	for i := 0 to List.Count-1 do
	3222	begin
	3223	tmp := TPCEItem(List[i]).HasCPTStr;
	3224	if(tmp <> '') then
	3225	AList.Add(tmp);
	3226	end;
	3227	end;
	3228
	3229	begin
	3230	AddList(FImmunizations);
	3231	AddList(FSkinTests);
	3232	AddList(FPatientEds);
	3233	AddList(FHealthFactors);
	3234	AddList(FExams);
	3235	end;
	3236
	3237	procedure TPCEData.CopyPCEItems(Src: TList; Dest: TObject; ItemClass: TPCEItemClass);
	3238	var
	3239	AItem: TPCEItem;
	3240	i: Integer;
	3241	IsStrings: boolean;
	3242
	3243	begin
	3244	if(Dest is TStrings) then
	3245	IsStrings := TRUE
	3246	else
	3247	if(Dest is TList) then
	3248	IsStrings := FALSE
	3249	else
	3250	exit;
	3251	for i := 0 to Src.Count - 1 do
	3252	begin
	3253	if(not TPCEItem(Src[i]).FDelete) then
	3254	begin
	3255	AItem := ItemClass.Create;
	3256	AItem.Assign(TPCEItem(Src[i]));
	3257	if(IsStrings) then
	3258	TStrings(Dest).AddObject(AItem.ItemStr, AItem)
	3259	else
	3260	TList(Dest).Add(AItem);
	3261	end;
	3262	end;
	3263	end;
	3264
	3265	function TPCEData.Empty: boolean;
	3266	begin
	3267	Result := (FProviders.Count = 0);
	3268	if(Result) then Result := (FSCRelated = SCC_NA);
	3269	if(Result) then Result := (FAORelated = SCC_NA);
	3270	if(Result) then Result := (FIRRelated = SCC_NA);
	3271	if(Result) then Result := (FECRelated = SCC_NA);
	3272	if(Result) then Result := (FMSTRelated = SCC_NA);
	3273	// if(Result) and HNCOK then Result := (FHNCRelated = SCC_NA);
	3274	if(Result) then Result := (FHNCRelated = SCC_NA);
	3275	if(Result) then Result := (FCVRelated = SCC_NA);
	3276	if(Result) then Result := (FDiagnoses.Count = 0);
	3277	if(Result) then Result := (FProcedures.Count = 0);
	3278	if(Result) then Result := (FImmunizations.Count = 0);
	3279	if(Result) then Result := (FSkinTests.Count = 0);
	3280	if(Result) then Result := (FPatientEds.Count = 0);
	3281	if(Result) then Result := (FHealthFactors.Count = 0);
	3282	if(Result) then Result := (fExams.Count = 0);
	3283	if(Result) then Result := (FVisitType.Empty);
	3284	end;
	3285
	3286	{ TPCEProviderList }
	3287
	3288	function TPCEProviderList.Add(const S: string): Integer;
	3289	var
	3290	SIEN: string;
	3291	LastPrimary: integer;
	3292
	3293	begin
	3294	SIEN := IntToStr(StrToInt64Def(Piece(S, U, pnumPrvdrIEN), 0));
	3295	if(SIEN = '0') then
	3296	Result := -1
	3297	else
	3298	begin
	3299	LastPrimary := PrimaryIdx;
	3300	Result := IndexOfProvider(SIEN);
	3301	if(Result < 0) then
	3302	Result := inherited Add(S)
	3303	else
	3304	Strings[Result] := S;
	3305	if(Piece(S, U, pnumPrvdrPrimary) = '1') then
	3306	begin
	3307	FNoUpdate := TRUE;
	3308	try
	3309	SetPrimaryIdx(Result);
	3310	finally
	3311	FNoUpdate := FALSE;
	3312	end;
	3313	if(assigned(FOnPrimaryChanged) and (LastPrimary <> PrimaryIdx)) then
	3314	FOnPrimaryChanged(Self);
	3315	end;
	3316	end;
	3317	end;
	3318
	3319	function TPCEProviderList.AddProvider(AIEN, AName: string; APrimary: boolean): integer;
	3320	var
	3321	tmp: string;
	3322
	3323	begin
	3324	tmp := 'PRV' + U + AIEN + U + U + U + AName + U;
	3325	if(APrimary) then tmp := tmp + '1';
	3326	Result := Add(tmp);
	3327	end;
	3328
	3329	procedure TPCEProviderList.Clear;
	3330	var
	3331	DoNotify: boolean;
	3332
	3333	begin
	3334	DoNotify := (assigned(FOnPrimaryChanged) and (GetPrimaryIdx >= 0));
	3335	FPendingDefault := '';
	3336	FPendingUser := '';
	3337	FPCEProviderIEN := 0;
	3338	FPCEProviderName := '';
	3339	inherited;
	3340	if(DoNotify) then
	3341	FOnPrimaryChanged(Self);
	3342	end;
	3343
	3344	procedure TPCEProviderList.Delete(Index: Integer);
	3345	var
	3346	DoNotify: boolean;
	3347
	3348	begin
	3349	DoNotify := (assigned(FOnPrimaryChanged) and (Piece(Strings[Index], U, pnumPrvdrPrimary) = '1'));
	3350	inherited Delete(Index);
	3351	if(DoNotify) then
	3352	FOnPrimaryChanged(Self);
	3353	end;
	3354
	3355	function TPCEProviderList.PCEProvider: Int64;
	3356
	3357	function Check(AIEN: Int64): Int64;
	3358	begin
	3359	if(AIEN = 0) or (IndexOfProvider(IntToStr(AIEN)) < 0) then
	3360	Result := 0
	3361	else
	3362	Result := AIEN;
	3363	end;
	3364
	3365	begin
	3366	Result := Check(Encounter.Provider);
	3367	if(Result = 0) then Result := Check(User.DUZ);
	3368	if(Result = 0) then Result := PrimaryIEN;
	3369	end;
	3370
	3371	function TPCEProviderList.PCEProviderName: string;
	3372	var
	3373	NewProv: Int64;
	3374
	3375	begin
	3376	NewProv := PCEProvider;
	3377	if(FPCEProviderIEN <> NewProv) then
	3378	begin
	3379	FPCEProviderIEN := NewProv;
	3380	FPCEProviderName := ExternalName(PCEProvider, FN_NEW_PERSON);
	3381	end;
	3382	Result := FPCEProviderName;
	3383	end;
	3384
	3385	function TPCEProviderList.GetPrimaryIdx: integer;
	3386	begin
	3387	Result := IndexOfPiece('1', U, pnumPrvdrPrimary);
	3388	end;
	3389
	3390	function TPCEProviderList.GetProviderData(Index: integer): TPCEProviderRec;
	3391	var
	3392	X: string;
	3393
	3394	begin
	3395	X := Strings[Index];
	3396	Result.IEN := StrToInt64Def(Piece(X, U, pnumPrvdrIEN), 0);
	3397	Result.Name := Piece(X, U, pnumPrvdrName);
	3398	Result.Primary := (Piece(X, U, pnumPrvdrPrimary) = '1');
	3399	Result.Delete := (Piece(X, U, 1) = 'PRV-');
	3400	end;
	3401
	3402	function TPCEProviderList.IndexOfProvider(AIEN: string): integer;
	3403	begin
	3404	Result := IndexOfPiece(AIEN, U, pnumPrvdrIEN);
	3405	end;
	3406
	3407	procedure TPCEProviderList.Merge(AList: TPCEProviderList);
	3408	var
	3409	i, idx: integer;
	3410	tmp: string;
	3411
	3412	begin
	3413	for i := 0 to Count-1 do
	3414	begin
	3415	tmp := Strings[i];
	3416	idx := AList.IndexOfProvider(Piece(tmp, U, pnumPrvdrIEN));
	3417	if(idx < 0) then
	3418	begin
	3419	SetPiece(tmp, U, 1, 'PRV-');
	3420	Strings[i] := tmp;
	3421	end;
	3422	end;
	3423	for i := 0 to AList.Count-1 do
	3424	Add(AList.Strings[i]); // Add already filters out duplicates
	3425	end;
	3426
	3427	function TPCEProviderList.PendingIEN(ADefault: boolean): Int64;
	3428	begin
	3429	if(ADefault) then
	3430	Result := StrToInt64Def(Piece(FPendingDefault, U, 1), 0)
	3431	else
	3432	Result := StrToInt64Def(Piece(FPendingUser, U, 1), 0);
	3433	end;
	3434
	3435	function TPCEProviderList.PendingName(ADefault: boolean): string;
	3436	begin
	3437	if(ADefault) then
	3438	Result := Piece(FPendingDefault, U, 2)
	3439	else
	3440	Result := Piece(FPendingUser, U, 2);
	3441	end;
	3442
	3443	function TPCEProviderList.PrimaryIEN: int64;
	3444	var
	3445	idx: integer;
	3446
	3447	begin
	3448	idx := GetPrimaryIdx;
	3449	if(idx < 0) then
	3450	Result := 0
	3451	else
	3452	Result := StrToInt64Def(Piece(Strings[idx], U, pnumPrvdrIEN), 0);
	3453	end;
	3454
	3455	function TPCEProviderList.PrimaryName: string;
	3456	var
	3457	idx: integer;
	3458
	3459	begin
	3460	idx := GetPrimaryIdx;
	3461	if(idx < 0) then
	3462	Result := ''
	3463	else
	3464	Result := Piece(Strings[idx], U, pnumPrvdrName);
	3465	end;
	3466
	3467	procedure TPCEProviderList.SetPrimary(index: integer; Primary: boolean);
	3468	var
	3469	tmp, x: string;
	3470
	3471	begin
	3472	tmp := Strings[index];
	3473	if(Primary) then
	3474	x := '1'
	3475	else
	3476	x := '';
	3477	SetPiece(tmp, U, pnumPrvdrPrimary, x);
	3478	Strings[Index] := tmp;
	3479	end;
	3480
	3481	procedure TPCEProviderList.SetPrimaryIdx(const Value: integer);
	3482	var
	3483	LastPrimary, idx: integer;
	3484	Found: boolean;
	3485
	3486	begin
	3487	LastPrimary := GetPrimaryIdx;
	3488	idx := -1;
	3489	Found := FALSE;
	3490	repeat
	3491	idx := IndexOfPiece('1', U, pnumPrvdrPrimary, idx);
	3492	if(idx >= 0) then
	3493	begin
	3494	if(idx = Value) then
	3495	Found := TRUE
	3496	else
	3497	SetPrimary(idx, FALSE);
	3498	end;
	3499	until(idx < 0);
	3500	if(not Found) and (Value >= 0) and (Value < Count) then
	3501	SetPrimary(Value, TRUE);
	3502	if((not FNoUpdate) and assigned(FOnPrimaryChanged) and (LastPrimary <> Value)) then
	3503	FOnPrimaryChanged(Self);
	3504	end;
	3505
	3506	procedure TPCEProviderList.SetProviderData(Index: integer;
	3507	const Value: TPCEProviderRec);
	3508	var
	3509	tmp, SIEN: string;
	3510
	3511	begin
	3512	if(Value.IEN = 0) or (index < 0) or (index >= Count) then exit;
	3513	SIEN := IntToStr(Value.IEN);
	3514	if(IndexOfPiece(SIEN, U, pnumPrvdrIEN) = index) then
	3515	begin
	3516	tmp := 'PRV';
	3517	if(Value.Delete) then tmp := tmp + '-';
	3518	tmp := tmp + U + SIEN + U + U + U + Value.Name + U;
	3519	Strings[index] := tmp;
	3520	if Value.Primary then
	3521	SetPrimaryIdx(Index);
	3522	end;
	3523	end;
	3524
	3525	procedure TPCEProviderList.Assign(Source: TPersistent);
	3526	var
	3527	Src: TPCEProviderList;
	3528
	3529	begin
	3530	inherited Assign(Source);
	3531	if(Source is TPCEProviderList) then
	3532	begin
	3533	Src := TPCEProviderList(Source);
	3534	Src.FOnPrimaryChanged := FOnPrimaryChanged;
	3535	Src.FPendingDefault := FPendingDefault;
	3536	Src.FPendingUser := FPendingUser;
	3537	Src.FPCEProviderIEN := FPCEProviderIEN;
	3538	Src.FPCEProviderName := FPCEProviderName;
	3539	end;
	3540	end;
	3541
	3542	initialization
	3543
	3544	finalization
	3545	KillObj(@PCESetsOfCodes);
	3546	KillObj(@HistLocations);
	3547
	3548	end.

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/Encounter/uPCE.pas@ 1806

Download in other formats: