Context Navigation

uPCE.pas@ 1706

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

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

Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Encounter/uPCE.pas@ 1706

Download in other formats: