Context Navigation

uPCE.pas@ 688

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

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

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

Context Navigation

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

Download in other formats: