Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

uPCE.pas@ 1692

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

Line
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@ 1692

Download in other formats: