source: cprs/trunk/CPRS-Chart/Encounter/uPCE.pas@ 493

Last change on this file since 493 was 456, checked in by Kevin Toppenberg, 16 years ago

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