Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

uPCE.pas@ 1591

Last change on this file since 1591 was 453, checked in by Kevin Toppenberg, 16 years ago
Initial upload of TMG-CPRS 1.0.26.69
File size: 119.4 KB

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

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

Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/uPCE.pas@ 1591

Download in other formats: