source: cprs/branches/foia-cprs/CPRS-Chart/Encounter/rPCE.pas@ 1382

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

Uploading from OR_30_258

File size: 45.6 KB
Line 
1unit rPCE;
2
3{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
4
5interface
6
7uses SysUtils, Classes, ORNet, ORFn, uPCE, UBACore, ORClasses;
8
9const
10 LX_ICD = 12;
11 LX_CPT = 13;
12
13 LX_Threshold = 15;
14
15 PCE_IMM = 20;
16 PCE_SK = 21;
17 PCE_PED = 22;
18 PCE_HF = 23;
19 PCE_XAM = 24;
20 PCE_TRT = 25;
21
22 SCC_YES = 1;
23 SCC_NO = 0;
24 SCC_NA = -1;
25
26var
27 uEncLocation: integer;
28// uEncDateTime: TFMDateTime;
29
30type
31 TSCConditions = record
32 SCAllow: Boolean; // prompt for service connected
33 SCDflt: Boolean; // default if prompting service connected
34 AOAllow: Boolean; // prompt for agent orange exposure
35 AODflt: Boolean; // default if prompting agent orange exposure
36 IRAllow: Boolean; // prompt for ionizing radiation exposure
37 IRDflt: Boolean; // default if prompting ionizing radiation
38 ECAllow: Boolean; // prompt for environmental conditions
39 ECDflt: Boolean; // default if prompting environmental cond.
40 MSTAllow: Boolean; // prompt for military sexual trauma
41 MSTDflt: Boolean; // default if prompting military sexual trauma
42 HNCAllow: Boolean; // prompt for Head or Neck Cancer
43 HNCDflt: Boolean; // default if prompting Head or Neck Cancer
44 CVAllow: Boolean; // prompt for Combat Veteran Related
45 CVDflt: Boolean; // default if prompting Comabt Veteran
46 end;
47
48 TPCEListCodesProc = procedure(Dest: TStrings; SectionIndex: Integer);
49
50 TAskPCE = (apPrimaryNeeded, apPrimaryOutpatient, apPrimaryAlways,
51 apNeeded, apOutpatient, apAlways, apNever, apDisable);
52
53function GetVisitCat(InitialCat: char; Location: integer; Inpatient: boolean): char;
54
55{assign and read values from fPCEData}
56//function SetRPCEncouterInfo(PCEData: TPCEData): boolean;
57function SetRPCEncLocation(Loc: Integer): boolean;
58//function SetRPCEncDateTime(DT: TFMDateTime): boolean;
59
60function PCERPCEncLocation: integer;
61//function PCERPCEncDateTime: TFMDateTime;
62function GetLocSecondaryVisitCode(Loc: integer): char;
63
64{check for active person class on provider}
65function CheckActivePerson(provider:string;DateTime:TFMDateTime): boolean;
66function ForcePCEEntry(Loc: integer): boolean;
67
68{"Other" form PCE calls}
69procedure LoadcboOther(Dest: TStrings; Location, fOtherApp: Integer);
70
71{ Lexicon Lookup Calls }
72function LexiconToCode(IEN, LexApp: Integer; ADate: TFMDateTime = 0): string;
73procedure ListLexicon(Dest: TStrings; const x: string; LexApp: Integer; ADate: TFMDateTime = 0);
74function IsActiveICDCode(ACode: string; ADate: TFMDateTime = 0): boolean;
75function IsActiveCPTCode(ACode: string; ADate: TFMDateTime = 0): boolean;
76function IsActiveCode(ACode: string; LexApp: integer; ADate: TFMDateTime = 0): boolean;
77
78{ Encounter Form Elements }
79procedure DeletePCE(const AVisitStr: string);
80function EligbleConditions: TSCConditions;
81
82procedure ListVisitTypeSections(Dest: TStrings);
83procedure ListVisitTypeCodes(Dest: TStrings; SectionIndex: Integer);
84procedure ListVisitTypeByLoc(Dest: TStrings; Location: Integer; ADateTime: TFMDateTime = 0);
85function AutoSelectVisit(Location: integer): boolean;
86function UpdateVisitTypeModifierList(Dest: TStrings; Index: integer): string;
87
88procedure ListDiagnosisSections(Dest: TStrings);
89procedure ListDiagnosisCodes(Dest: TStrings; SectionIndex: Integer);
90
91procedure ListExamsSections(Dest: TStrings);
92procedure ListExamsCodes(Dest: TStrings; SectionIndex: Integer);
93
94procedure ListHealthSections(Dest: TStrings);
95procedure ListHealthCodes(Dest: TStrings; SectionIndex: Integer);
96
97procedure ListImmunizSections(Dest: TStrings);
98procedure ListImmunizCodes(Dest: TStrings; SectionIndex: Integer);
99
100procedure ListPatientSections(Dest: TStrings);
101procedure ListPatientCodes(Dest: TStrings; SectionIndex: Integer);
102
103procedure ListProcedureSections(Dest: TStrings);
104procedure ListProcedureCodes(Dest: TStrings; SectionIndex: Integer);
105function ModifierList(CPTCode: string): string;
106procedure ListCPTModifiers(Dest: TStrings; CPTCodes, NeededModifiers: string);
107function ModifierName(ModIEN: string): string;
108function ModifierCode(ModIEN: string): string;
109function UpdateModifierList(Dest: TStrings; Index: integer): string;
110
111procedure ListSkinSections(Dest: TStrings);
112procedure ListSkinCodes(Dest: TStrings; SectionIndex: Integer);
113
114procedure ListSCDisabilities(Dest: TStrings);
115procedure LoadPCEDataForNote(Dest: TStrings; ANoteIEN: Integer; VStr: string);
116function GetVisitIEN(NoteIEN: Integer): string;
117procedure SavePCEData(PCEList: TStringList; ANoteIEN, ALocation: integer);
118
119function DataHasCPTCodes(AList: TStrings): boolean;
120function GetAskPCE(Loc: integer): TAskPCE;
121function HasVisit(const ANoteIEN, ALocation: integer; const AVisitDate: TFMDateTime): Integer;
122
123procedure LoadImmSeriesItems(Dest: TStrings);
124procedure LoadImmReactionItems(Dest: TStrings);
125procedure LoadSkResultsItems(Dest: TStrings);
126procedure LoadPEDLevelItems(Dest: TStrings);
127procedure LoadHFLevelItems(Dest: TStrings);
128procedure LoadXAMResultsItems(Dest: TStrings);
129procedure LoadHistLocations(Dest: TStrings);
130procedure AddProbsToDiagnoses;
131
132//GAF
133function GAFOK: boolean;
134function MHClinic(const Location: integer): boolean;
135procedure RecentGAFScores(const Limit: integer);
136function SaveGAFScore(const Score: integer; GAFDate: TFMDateTime; Staff: Int64): boolean;
137function GAFURL: string;
138function MHTestsOK: boolean;
139function MHTestAuthorized(Test: string): boolean;
140
141function AnytimeEncounters: boolean;
142function AutoCheckout(Loc: integer): boolean;
143
144{ Encounter }
145//function RequireExposures(ANote: Integer): Boolean; {RAB}
146function RequireExposures(ANote, ATitle: Integer): Boolean;
147function PromptForWorkload(ANote, ATitle: Integer; VisitCat: Char; StandAlone: boolean): Boolean;
148function DefaultProvider(ALocation: integer; AUser: Int64; ADate: TFMDateTime;
149 ANoteIEN: integer): string;
150function IsUserAProvider(AUser: Int64; ADate: TFMDateTime): boolean;
151function IsCancelOrNoShow(ANote: integer): boolean;
152function IsNonCountClinic(ALocation: integer): boolean;
153
154// HNC Flag
155//function HNCOK: boolean;
156
157implementation
158
159uses TRPCB, rCore, uCore, uConst, fEncounterFrame, UBAGlobals, UBAConst;
160
161var
162 uLastLocation: Integer;
163 uLastDFN: String;
164 uVTypeLastLoc: Integer;
165 uVTypeLastDate: double = 0;
166 uDiagnoses: TStringList;
167 uExams: TStringList;
168 uHealthFactors: TStringList;
169 uImmunizations: TStringList;
170 uPatientEds: TStringList;
171 uProcedures: TStringList;
172 uSkinTests: TStringList;
173 uVisitTypes: TStringList;
174 uVTypeForLoc: TStringList;
175 uProblems: TStringList;
176 uModifiers: TORStringList = nil;
177 uGAFOK: boolean;
178 uGAFOKCalled: boolean = FALSE;
179 uLastForceLoc: integer = -1;
180 uLastForce: boolean;
181 uHasCPT: TStringList = nil;
182 uGAFURL: string;
183 uGAFURLChecked: boolean = FALSE;
184 uMHOK: boolean;
185 uMHOKChecked: boolean = FALSE;
186 uVCInitialCat: char = #0;
187 uVCLocation: integer = -2;
188 uVCInpatient: boolean = FALSE;
189 uVCResult: char;
190 uAPUser: Int64 = -1;
191 uAPLoc: integer = -2;
192 uAPAsk: TAskPCE;
193 uAnytimeEnc: integer = -1;
194 UAutoSelLoc: integer = -1;
195 UAutoSelVal: boolean;
196 uLastChkOut: boolean;
197 uLastChkOutLoc: integer = -2;
198 uLastIsClinicLoc: integer = 0;
199 uLastIsClinic: boolean = FALSE;
200// uHNCOK: integer = -1;
201
202function GetVisitCat(InitialCat: char; Location: integer; Inpatient: boolean): char;
203var
204 tmp: string;
205
206begin
207 if(InitialCat <> uVCInitialCat) or (Location <> uVCLocation) or
208 (Inpatient <> uVCInpatient) then
209 begin
210 uVCInitialCat := InitialCat;
211 uVCLocation := Location;
212 uVCInpatient := Inpatient;
213 tmp := sCallV('ORWPCE GETSVC', [InitialCat, Location, BOOLCHAR[Inpatient]]);
214 if(tmp <> '') then
215 uVCResult := tmp[1]
216 else
217 uVCResult := InitialCat;
218 end;
219 Result := uVCResult
220end;
221
222{ Lexicon Lookup Calls }
223
224function LexiconToCode(IEN, LexApp: Integer; ADate: TFMDateTime = 0): string;
225var
226 CodeSys: string;
227begin
228 case LexApp of
229 LX_ICD: CodeSys := 'ICD';
230 LX_CPT: CodeSys := 'CHP';
231 end;
232 Result := sCallV('ORWPCE LEXCODE', [IEN, CodeSys, ADate]);
233end;
234
235procedure ListLexicon(Dest: TStrings; const x: string; LexApp: Integer; ADate: TFMDateTime = 0);
236var
237 CodeSys: string;
238begin
239 case LexApp of
240 LX_ICD: CodeSys := 'ICD';
241 LX_CPT: CodeSys := 'CHP';
242 end;
243 CallV('ORWPCE LEX', [x, CodeSys, ADate]);
244 Dest.Assign(RPCBrokerV.Results);
245end;
246
247function IsActiveICDCode(ACode: string; ADate: TFMDateTime = 0): boolean;
248begin
249 Result := IsActiveCode(ACode, LX_ICD, ADate);
250end;
251
252function IsActiveCPTCode(ACode: string; ADate: TFMDateTime = 0): boolean;
253begin
254 Result := IsActiveCode(ACode, LX_CPT, ADate);
255end;
256
257function IsActiveCode(ACode: string; LexApp: integer; ADate: TFMDateTime = 0): boolean;
258var
259 CodeSys: string;
260begin
261 case LexApp of
262 LX_ICD: CodeSys := 'ICD';
263 LX_CPT: CodeSys := 'CHP';
264 end;
265 Result := (sCallV('ORWPCE ACTIVE CODE',[ACode, CodeSys, ADate]) = '1');
266end;
267
268{ Encounter Form Elements ------------------------------------------------------------------ }
269
270procedure DeletePCE(const AVisitStr: string);
271begin
272 sCallV('ORWPCE DELETE', [AVisitStr, Patient.DFN]);
273end;
274
275procedure LoadEncounterForm;
276{ load the major coding lists that are used by the encounter form for a given location }
277var
278 i: integer;
279 uTempList: TStringList;
280 EncDt: TFMDateTime;
281
282begin
283 uLastLocation := uEncLocation;
284 EncDt := Trunc(uEncPCEData.VisitDateTime);
285
286 //add problems to the top of diagnoses.
287 uTempList := TstringList.Create;
288
289
290 if UBAGlobals.BILLING_AWARE then //BAPHII 1.3.10
291 begin
292 UBACore.BADxList := TStringList.Create;
293 end;
294
295 try
296 uDiagnoses.clear;
297
298 if BILLING_AWARE then
299 begin
300 UBACore.BADxList.Clear; //BAPHII 1.3.10
301 end;
302
303 tCallV(uTempList, 'ORWPCE DIAG', [uEncLocation, EncDt]); //BAPHII 1.3.10
304 uDiagnoses.add(utemplist.strings[0]); //BAPHII 1.3.10
305 AddProbsToDiagnoses; //BAPHII 1.3.10
306 // BA 25 AddProviderPatientDaysDx(uDxLst, IntToStr(Encounter.Provider), Patient.DFN);
307 for i := 1 to (uTempList.Count-1) do //BAPHII 1.3.10
308 uDiagnoses.add(uTemplist.strings[i]); //BAPHII 1.3.10
309
310 finally
311 uTempList.free;
312 end;
313
314 tCallV(uVisitTypes, 'ORWPCE VISIT', [uEncLocation, EncDt]);
315 tCallV(uProcedures, 'ORWPCE PROC', [uEncLocation, EncDt]);
316 tCallV(uImmunizations, 'ORWPCE IMM', [uEncLocation]);
317 tCallV(uSkinTests, 'ORWPCE SK', [uEncLocation]);
318 tCallV(uPatientEds, 'ORWPCE PED', [uEncLocation]);
319 tCallV(uHealthFactors, 'ORWPCE HF', [uEncLocation]);
320 tCallV(uExams, 'ORWPCE XAM', [uEncLocation]);
321
322 if uVisitTypes.Count > 0 then uVisitTypes.Delete(0); // discard counts
323 if uDiagnoses.Count > 0 then uDiagnoses.Delete(0);
324 if uProcedures.Count > 0 then uProcedures.Delete(0);
325 if uImmunizations.Count > 0 then uImmunizations.Delete(0);
326 if uSkinTests.Count > 0 then uSkinTests.Delete(0);
327 if uPatientEds.Count > 0 then uPatientEds.Delete(0);
328 if uHealthFactors.Count > 0 then uHealthFactors.Delete(0);
329 if uExams.Count > 0 then uExams.Delete(0);
330
331 if (uVisitTypes.Count > 0) and (CharAt(uVisitTypes[0], 1) <> U) then uVisitTypes.Insert(0, U);
332 if (uDiagnoses.Count > 0) and (CharAt(uDiagnoses[0], 1) <> U) then uDiagnoses.Insert(0, U);
333 if (uProcedures.Count > 0) and (CharAt(uProcedures[0], 1) <> U) then uProcedures.Insert(0, U);
334 if (uImmunizations.Count > 0) and (CharAt(uImmunizations[0], 1) <> U) then uImmunizations.Insert(0, U);
335 if (uSkinTests.Count > 0) and (CharAt(uSkinTests[0], 1) <> U) then uSkinTests.Insert(0, U);
336 if (uPatientEds.Count > 0) and (CharAt(uPatientEds[0], 1) <> U) then uPatientEds.Insert(0, U);
337 if (uHealthFactors.Count > 0) and (CharAt(uHealthFactors[0], 1) <> U) then uHealthFactors.Insert(0, U);
338 if (uExams.Count > 0) and (CharAt(uExams[0], 1) <> U) then uExams.Insert(0, U);
339
340end;
341
342{Visit Types-------------------------------------------------------------------}
343procedure ListVisitTypeSections(Dest: TStrings);
344{ return section names in format: ListIndex^SectionName (sections begin with '^') }
345var
346 i: Integer;
347 x: string;
348begin
349 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
350 for i := 0 to uVisitTypes.Count - 1 do if CharAt(uVisitTypes[i], 1) = U then
351 begin
352 x := Piece(uVisitTypes[i], U, 2);
353 if Length(x) = 0 then x := '<No Section Name>';
354 Dest.Add(IntToStr(i) + U + Piece(uVisitTypes[i], U, 2) + U + x);
355 end;
356end;
357
358procedure ListVisitTypeCodes(Dest: TStrings; SectionIndex: Integer);
359{ return visit types in format: visit type <TAB> amount of time <TAB> CPT code <TAB> CPT code }
360var
361 i: Integer;
362 s: string;
363
364 function InsertTab(x: string): string;
365 { turn the white space between the name and the number of minutes into a single tab }
366 begin
367 if CharAt(x, 20) = ' '
368 then Result := Trim(Copy(x, 1, 20)) + U + Trim(Copy(x, 21, Length(x)))
369 else Result := Trim(x) + U;
370 end;
371
372begin {ListVisitTypeCodes}
373 Dest.Clear;
374 i := SectionIndex + 1; // first line after the section name
375 while (i < uVisitTypes.Count) and (CharAt(uVisitTypes[i], 1) <> U) do
376 begin
377 s := Pieces(uVisitTypes[i], U, 1, 2) + U + InsertTab(Piece(uVisitTypes[i], U, 2)) + U + Piece(uVisitTypes[i], U, 1) +
378 U + IntToStr(i);
379 Dest.Add(s);
380 Inc(i);
381 end;
382end;
383
384procedure ListVisitTypeByLoc(Dest: TStrings; Location: Integer; ADateTime: TFMDateTime = 0);
385var
386 i: Integer;
387 x, SectionName: string;
388 EncDt: TFMDateTime;
389begin
390 EncDt := Trunc(ADateTime);
391 if (uVTypeLastLoc <> Location) or (uVTypeLastDate <> EncDt) then
392 begin
393 uVTypeForLoc.Clear;
394 if Location = 0 then Exit;
395 SectionName := '';
396 CallV('ORWPCE VISIT', [Location, EncDt]);
397 with RPCBrokerV do for i := 0 to Results.Count - 1 do
398 begin
399 x := Results[i];
400 if CharAt(x, 1) = U
401 then SectionName := Piece(x, U, 2)
402 else uVTypeForLoc.Add(Piece(x, U, 1) + U + SectionName + U + Piece(x, U, 2));
403 end;
404 uVTypeLastLoc := Location;
405 uVTypeLastDate := EncDt;
406 end;
407 Dest.Assign(uVTypeForLoc);
408end;
409
410function AutoSelectVisit(Location: integer): boolean;
411begin
412 if UAutoSelLoc <> Location then
413 begin
414 UAutoSelVal := (sCallV('ORWPCE AUTO VISIT TYPE SELECT', [Location]) = '1');
415 UAutoSelLoc := Location;
416 end;
417 Result := UAutoSelVal;
418end;
419
420{Diagnosis---------------------------------------------------------------------}
421procedure ListDiagnosisSections(Dest: TStrings);
422{ return section names in format: ListIndex^SectionName (sections begin with '^') }
423var
424 i: Integer;
425 x: string;
426begin
427 //// if (uLastLocation <> uEncLocation) then LoadEncounterForm;
428 // if (uLastDFN <> patient.DFN) then LoadEncounterForm;// commented out for CIDC needs.
429 LoadEncounterForm;
430 for i := 0 to uDiagnoses.Count - 1 do if CharAt(uDiagnoses[i], 1) = U then
431 begin
432 x := Piece(uDiagnoses[i], U, 2);
433 if Length(x) = 0 then x := '<No Section Name>';
434 Dest.Add(IntToStr(i) + U + Piece(uDiagnoses[i], U, 2) + U + x);
435 end;
436end;
437
438procedure ListDiagnosisCodes(Dest: TStrings; SectionIndex: Integer);
439{ return diagnoses within section in format:
440 diagnosis <TAB> ICDInteger <TAB> .ICDDecimal <TAB> ICD Code }
441var
442 i: Integer;
443 s,d: string;
444 EncDT: TFMDateTime;
445
446begin
447 EncDT := uEncPCEData.VisitDateTime;
448 Dest.Clear;
449 i := SectionIndex + 1; // first line after the section name
450 while (i < uDiagnoses.Count) and (CharAt(uDiagnoses[i], 1) <> U) do
451 begin
452 s := Piece(uDiagnoses[i], U, 1);
453 d := Piece(s, '.', 2);
454 s := s + U + Piece(uDiagnoses[i], U, 2) + U + Piece(s, '.', 1) + U;
455 if(d <> '') then
456 SetPiece(s, U, 4, '.' + d )
457 else // RV - CSV - need to do this so trailing "#" lines up correctly when no decimals
458 SetPiece(s, U, 4, ' ');
459
460 //filtering out inactive codes.
461 if (Piece(uDiagnoses[i], U, 3) = '#') then
462 begin
463 SetPiece(s, U, 5, '#');
464 Dest.Add(s);
465 end
466 else if ((Piece(uDiagnoses[i], U, 3) = '') or
467 ( StrToFloat(Piece(uDiagnoses[i], U, 3)) > EncDT )) then
468 begin
469 Dest.Add(s);
470 end;
471 Inc(i);
472 end;
473end;
474
475procedure AddProbsToDiagnoses;
476var
477 i: integer; //loop index
478 EncDT: TFMDateTime;
479begin
480 //get problem list
481 EncDT := Trunc(uEncPCEData.VisitDateTime);
482 uLastDFN := patient.DFN;
483 tCallV(uProblems, 'ORWPCE ACTPROB',[Patient.DFN, EncDT]);
484 if uProblems.count > 0 then
485 begin
486 //add category to udiagnoses
487 uDiagnoses.add(U + DX_PROBLEM_LIST_TXT);
488 for i := 1 to (uProblems.count-1) do //start with 1 because strings[0] is
489 //the count of elements.
490 begin
491 //add problems to udiagnosis.
492 if (piece(uproblems.Strings[i],U,3) = '799.9') then continue; // DON'T INCLUDE 799.9 CODES
493
494 if (Piece(uproblems.Strings[i], U, 11) = '#') then
495 uDiagnoses.add(piece(uProblems.Strings[i],U,3) + U + // PL code inactive
496 piece(uProblems.Strings[i],U,2) + U + '#')
497 else if (Piece(uproblems.Strings[i], U, 10) = '') then // no inactive date for code
498 uDiagnoses.add(piece(uProblems.Strings[i],U,3) + U +
499 piece(uProblems.Strings[i],U,2))
500 else if (Trunc(StrToFloat(Piece(uProblems.Strings[i], U, 10))) > EncDT) then // code active as of EncDt
501 uDiagnoses.add(piece(uProblems.Strings[i],U,3) + U +
502 piece(uProblems.Strings[i],U,2))
503 else
504 uDiagnoses.add(piece(uProblems.Strings[i],U,3) + U + // PL code inactive
505 piece(uProblems.Strings[i],U,2) + U + '#');
506 end;
507
508 //1.3.10
509 if BILLING_AWARE then
510 begin
511 // add New Section and dx codes to Encounter Diagnosis Section and Code List.
512 // Diagnoses -> Provider/Patient/24 hrs
513 uDiagnoses.add(UBAConst.ENCOUNTER_TODAYS_DX); //BAPHII 1.3.10
514 //BADxList := AddProviderPatientDaysDx(UBACore.uDxLst, IntToStr(Encounter.Provider), Patient.DFN); //BAPHII 1.3.10
515 rpcGetProviderPatientDaysDx(IntToStr(Encounter.Provider), Patient.DFN); //BAPHII 1.3.10
516
517 for i := 0 to (UBACore.uDxLst.Count-1) do //BAPHII 1.3.10
518 uDiagnoses.add(UBACore.uDxLst[i]); //BAPHII 1.3.10
519 // Code added after presentation.....
520 // Add Personal Diagnoses Section and Codes to Encounter Diagnosis Section and Code List.
521 UBACore.uDxLst.Clear;
522 uDiagnoses.Add(UBAConst.ENCOUNTER_PERSONAL_DX);
523 UBACore.uDxLst := rpcGetPersonalDxList(User.DUZ);
524 for i := 0 to (UBACore.uDxLst.Count -1) do
525 begin
526 uDiagnoses.Add(UBACore.uDxLst.Strings[i]);
527 end;
528 end;
529
530 end;
531end;
532{Immunizations-----------------------------------------------------------------}
533procedure LoadImmReactionItems(Dest: TStrings);
534begin
535 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.11','.06','1']);
536end;
537
538procedure LoadImmSeriesItems(Dest: TStrings);
539{loads items into combo box on Immunixation screen}
540begin
541 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.11','.04','1']);
542end;
543
544procedure ListImmunizSections(Dest: TStrings);
545{ return section names in format: ListIndex^SectionName (sections begin with '^') }
546var
547 i: Integer;
548 x: string;
549begin
550 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
551 for i := 0 to uImmunizations.Count - 1 do if CharAt(uImmunizations[i], 1) = U then
552 begin
553 x := Piece(uImmunizations[i], U, 2);
554 if Length(x) = 0 then x := '<No Section Name>';
555 Dest.Add(IntToStr(i) + U + Piece(uImmunizations[i], U, 2) + U + x);
556 end;
557end;
558
559procedure ListImmunizCodes(Dest: TStrings; SectionIndex: Integer);
560{ return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
561var
562 i: Integer;
563begin
564 Dest.Clear;
565 i := SectionIndex + 1; // first line after the section name
566 while (i < uImmunizations.Count) and (CharAt(uImmunizations[i], 1) <> U) do
567 begin
568 Dest.Add(Pieces(uImmunizations[i], U, 1, 2));
569 Inc(i);
570 end;
571end;
572
573
574{Procedures--------------------------------------------------------------------}
575procedure ListProcedureSections(Dest: TStrings);
576{ return section names in format: ListIndex^SectionName (sections begin with '^') }
577var
578 i: Integer;
579 x: string;
580begin
581 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
582 for i := 0 to uProcedures.Count - 1 do if CharAt(uProcedures[i], 1) = U then
583 begin
584 x := Piece(uProcedures[i], U, 2);
585 if Length(x) = 0 then x := '<No Section Name>';
586 Dest.Add(IntToStr(i) + U + Piece(uProcedures[i], U, 2) + U + x);
587 end;
588end;
589
590procedure ListProcedureCodes(Dest: TStrings; SectionIndex: Integer);
591{ return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
592//Piece 12 are CPT Modifiers, Piece 13 is a flag indicating conversion of Piece 12 from
593//modifier code to modifier IEN (updated in UpdateModifierList routine)
594var
595 i: Integer;
596begin
597 Dest.Clear;
598 i := SectionIndex + 1; // first line after the section name
599 while (i < uProcedures.Count) and (CharAt(uProcedures[i], 1) <> U) do
600 begin
601 Dest.Add(Pieces(uProcedures[i], U, 1, 2) + U + Piece(uProcedures[i], U, 1) + U +
602 Piece(uProcedures[i], U, 12) + U + Piece(uProcedures[i], U, 13) + U +
603 IntToStr(i));
604 Inc(i);
605 end;
606end;
607
608function MixedCaseModifier(const inStr: string): string;
609begin
610 Result := inStr;
611 SetPiece(Result, U, 2, MixedCase(Trim(Piece(Result, U, 2))));
612end;
613
614function ModifierIdx(ModIEN: string): integer;
615var
616 EncDt: TFMDateTime;
617begin
618 Result := uModifiers.IndexOfPiece(ModIEN);
619 if(Result < 0) then
620 begin
621 if Assigned(uEncPCEData) then // may not exist yet on display of note and PCE data
622 EncDT := Trunc(uEncPCEData.VisitDateTime)
623 else if Encounter.DateTime > 0 then // really need note date/time next, but can't get to it
624 EncDT := Trunc(Encounter.DateTime)
625 else
626 EncDT := FMToday;
627 Result := uModifiers.Add(MixedCaseModifier(sCallV('ORWPCE GETMOD', [ModIEN, EncDt])));
628 end;
629end;
630
631function ModifierList(CPTCode: string): string;
632// uModifiers list contains <@>CPTCode;ModCount;^Mod1Index^Mod2Index^...^ModNIndex
633// or MODIEN^MODDescription^ModCode
634
635const
636 CPTCodeHeader = '<@>';
637
638var
639 i, idx: integer;
640 s, ModIEN: string;
641 EncDt: TFMDateTime;
642begin
643 EncDT := Trunc(uEncPCEData.VisitDateTime);
644 idx := uModifiers.IndexOfPiece(CPTCodeHeader + CPTCode, ';', 1);
645 if(idx < 0) then
646 begin
647 CallV('ORWPCE CPTMODS', [CPTCode, EncDt]);
648 s := CPTCodeHeader + CPTCode + ';' + IntToStr(RPCBrokerV.Results.Count) + ';' + U;
649 for i := 0 to RPCBrokerV.Results.Count - 1 do
650 begin
651 ModIEN := piece(RPCBrokerV.Results[i], U, 1);
652 idx := uModifiers.IndexOfPiece(ModIEN);
653 if(idx < 0) then
654 idx := uModifiers.Add(MixedCaseModifier(RPCBrokerV.Results[i]));
655 s := s + IntToStr(idx) + U;
656 end;
657 idx := uModifiers.Add(s);
658 end;
659 Result := uModifiers[idx];
660end;
661
662procedure ListCPTModifiers(Dest: TStrings; CPTCodes, NeededModifiers: string);
663//CPTCodes expected in the format of code^code^code
664//NeededModifiers in format of ModIEN1;ModIEN2;ModIEN3
665var
666 TmpSL: TStringList;
667 i, j, idx, cnt, found: integer;
668 s, Code: string;
669
670begin
671 if(not assigned(uModifiers)) then uModifiers := TORStringList.Create;
672 if(copy(CPTCodes, length(CPTCodes), 1) <> U) then
673 CPTCodes := CPTCodes + U;
674 if(copy(NeededModifiers, length(NeededModifiers), 1) <> ';') then
675 NeededModifiers := NeededModifiers + ';';
676
677 TmpSL := TStringList.Create;
678 try
679 repeat
680 i := pos(U, CPTCodes);
681 if(i > 0) then
682 begin
683 Code := copy(CPTCodes, 1, i-1);
684 delete(CPTCodes,1,i);
685 if(Code <> '') then
686 TmpSL.Add(ModifierList(Code));
687 i := pos(U, CPTCodes);
688 end;
689 until(i = 0);
690 if(TmpSL.Count = 0) then
691 s := ';0;'
692 else
693 if(TmpSL.Count = 1) then
694 s := TmpSL[0]
695 else
696 begin
697 s := '';
698 found := 0;
699 cnt := StrToIntDef(piece(TmpSL[0], ';', 2), 0);
700 for i := 1 to cnt do
701 begin
702 Code := U + Piece(TmpSL[0], U, i+1);
703 for j := 1 to TmpSL.Count-1 do
704 begin
705 if(pos(Code + U, TmpSL[j]) = 0) then
706 begin
707 Code := '';
708 break;
709 end;
710 end;
711 if(Code <> '') then
712 begin
713 s := s + Code;
714 inc(found);
715 end;
716 end;
717 s := s + U;
718 SetPiece(s , U, 1, ';' + IntToStr(Found) + ';');
719 end;
720 finally
721 TmpSL.Free;
722 end;
723
724 Dest.Clear;
725 cnt := StrToIntDef(piece(s, ';', 2), 0);
726 if(NeededModifiers <> '') then
727 begin
728 found := cnt;
729 repeat
730 i := pos(';',NeededModifiers);
731 if(i > 0) then
732 begin
733 idx := StrToIntDef(copy(NeededModifiers,1,i-1),0);
734 if(idx > 0) then
735 begin
736 Code := IntToStr(ModifierIdx(IntToStr(idx))) + U;
737 if(pos(U+Code, s) = 0) then
738 begin
739 s := s + Code;
740 inc(cnt);
741 end;
742 end;
743 delete(NeededModifiers,1,i);
744 end;
745 until(i = 0);
746 if(found <> cnt) then
747 SetPiece(s , ';', 2, IntToStr(cnt));
748 end;
749 for i := 1 to cnt do
750 begin
751 idx := StrToIntDef(piece(s, U, i + 1), -1);
752 if(idx >= 0) then
753 Dest.Add(uModifiers[idx]);
754 end;
755end;
756
757function ModifierName(ModIEN: string): string;
758begin
759 if(not assigned(uModifiers)) then uModifiers := TORStringList.Create;
760 Result := piece(uModifiers[ModifierIdx(ModIEN)], U, 2);
761end;
762
763function ModifierCode(ModIEN: string): string;
764begin
765 if(not assigned(uModifiers)) then uModifiers := TORStringList.Create;
766 Result := piece(uModifiers[ModifierIdx(ModIEN)], U, 3);
767end;
768
769function UpdateModifierList(Dest: TStrings; Index: integer): string;
770var
771 i, idx, LastIdx: integer;
772 Tmp, OKMods, Code: string;
773 OK: boolean;
774
775begin
776 if(Piece(Dest[Index], U, 5) = '1') then
777 Result := Piece(Dest[Index],U,4)
778 else
779 begin
780 Tmp := Piece(Dest[Index], U, 4);
781 Result := '';
782 OKMods := ModifierList(Piece(Dest[Index], U, 1))+U;
783 i := 1;
784 repeat
785 Code := Piece(Tmp,';',i);
786 if(Code <> '') then
787 begin
788 LastIdx := -1;
789 OK := FALSE;
790 repeat
791 idx := uModifiers.IndexOfPiece(Code, U, 3, LastIdx);
792 if(idx > 0) then
793 begin
794 if(pos(U + IntToStr(idx) + U, OKMods)>0) then
795 begin
796 Result := Result + piece(uModifiers[idx],U,1) + ';';
797 OK := TRUE;
798 end
799 else
800 LastIdx := Idx;
801 end;
802 until(idx < 0) or OK;
803 inc(i);
804 end
805 until(Code = '');
806 Tmp := Dest[Index];
807 SetPiece(Tmp,U,4,Result);
808 SetPiece(Tmp,U,5,'1');
809 Dest[Index] := Tmp;
810 idx := StrToIntDef(piece(Tmp,U,6),-1);
811 if(idx >= 0) then
812 begin
813 Tmp := uProcedures[idx];
814 SetPiece(Tmp,U,12,Result);
815 SetPiece(Tmp,U,13,'1');
816 uProcedures[idx] := Tmp;
817 end;
818 end;
819end;
820
821function UpdateVisitTypeModifierList(Dest: TStrings; Index: integer): string;
822var
823 i, idx, LastIdx: integer;
824 Tmp, OKMods, Code: string;
825 OK: boolean;
826
827begin
828 if(Piece(Dest[Index], U, 7) = '1') then
829 Result := Piece(Dest[Index],U,6)
830 else
831 begin
832 Tmp := Piece(Dest[Index], U, 6);
833 Result := '';
834 OKMods := ModifierList(Piece(Dest[Index], U, 1))+U;
835 i := 1;
836 repeat
837 Code := Piece(Tmp,';',i);
838 if(Code <> '') then
839 begin
840 LastIdx := -1;
841 OK := FALSE;
842 repeat
843 idx := uModifiers.IndexOfPiece(Code, U, 3, LastIdx);
844 if(idx > 0) then
845 begin
846 if(pos(U + IntToStr(idx) + U, OKMods)>0) then
847 begin
848 Result := Result + piece(uModifiers[idx],U,1) + ';';
849 OK := TRUE;
850 end
851 else
852 LastIdx := Idx;
853 end;
854 until(idx < 0) or OK;
855 inc(i);
856 end
857 until(Code = '');
858 Tmp := Dest[Index];
859 SetPiece(Tmp,U,6,Result);
860 SetPiece(Tmp,U,7,'1');
861 Dest[Index] := Tmp;
862 idx := StrToIntDef(piece(Tmp,U,8),-1);
863 if(idx >= 0) then
864 begin
865 Tmp := uProcedures[idx];
866 SetPiece(Tmp,U,12,Result);
867 SetPiece(Tmp,U,13,'1');
868 uProcedures[idx] := Tmp;
869 end;
870 end;
871end;
872
873
874{SkinTests---------------------------------------------------------------------}
875procedure LoadSkResultsItems(Dest: TStrings);
876begin
877 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.12','.04','1']);
878end;
879
880procedure ListSkinSections(Dest: TStrings);
881{ return section names in format: ListIndex^SectionName (sections begin with '^') }
882var
883 i: Integer;
884 x: string;
885begin
886 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
887 for i := 0 to uSkinTests.Count - 1 do if CharAt(uSkinTests[i], 1) = U then
888 begin
889 x := Piece(uSkinTests[i], U, 2);
890 if Length(x) = 0 then x := '<No Section Name>';
891 Dest.Add(IntToStr(i) + U + Piece(uSkinTests[i], U, 2) + U + x);
892 end;
893end;
894
895
896procedure ListSkinCodes(Dest: TStrings; SectionIndex: Integer);
897{ return procedures within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
898var
899 i: Integer;
900begin
901 Dest.Clear;
902 i := SectionIndex + 1; // first line after the section name
903 while (i < uSkinTests.Count) and (CharAt(uSkinTests[i], 1) <> U) do
904 begin
905 Dest.Add(Pieces(uSkinTests[i], U, 1, 2));
906 Inc(i);
907 end;
908end;
909
910
911{Patient Education-------------------------------------------------------------}
912procedure LoadPEDLevelItems(Dest: TStrings);
913begin
914 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.16','.06','1']);
915end;
916
917procedure ListPatientSections(Dest: TStrings);
918{ return Sections in format: ListIndex^SectionName (sections begin with '^') }
919var
920 i: Integer;
921 x: string;
922begin
923 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
924 for i := 0 to uPatientEds.Count - 1 do if CharAt(uPatientEds[i], 1) = U then
925 begin
926 x := Piece(uPatientEds[i], U, 2);
927 if Length(x) = 0 then x := '<No Section Name>';
928 Dest.Add(IntToStr(i) + U + Piece(uPatientEds[i], U, 2) + U + x);
929 end;
930end;
931
932
933procedure ListPatientCodes(Dest: TStrings; SectionIndex: Integer);
934{ return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
935var
936 i: Integer;
937begin
938 Dest.Clear;
939 i := SectionIndex + 1; // first line after the section name
940 while (i < uPatientEds.Count) and (CharAt(uPatientEds[i], 1) <> U) do
941 begin
942 Dest.Add(Pieces(uPatientEds[i], U, 1, 2));
943 Inc(i);
944 end;
945end;
946
947
948
949{HealthFactors-------------------------------------------------------------}
950procedure LoadHFLevelItems(Dest: TStrings);
951begin
952 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.23','.04','1']);
953end;
954
955procedure ListHealthSections(Dest: TStrings);
956{ return Sections in format: ListIndex^SectionName (sections begin with '^') }
957var
958 i: Integer;
959 x: string;
960begin
961 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
962 for i := 0 to uHealthFactors.Count - 1 do if CharAt(uHealthFactors[i], 1) = U then
963 begin
964 x := Piece(uHealthFactors[i], U, 2);
965 if Length(x) = 0 then x := '<No Section Name>';
966 Dest.Add(IntToStr(i) + U + Piece(uHealthFactors[i], U, 2) + U + x);
967 end;
968end;
969
970
971procedure ListHealthCodes(Dest: TStrings; SectionIndex: Integer);
972{ return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
973var
974 i: Integer;
975begin
976 Dest.Clear;
977 i := SectionIndex + 1; // first line after the section name
978 while (i < uHealthFactors.Count) and (CharAt(uHealthFactors[i], 1) <> U) do
979 begin
980 Dest.Add(Pieces(uHealthFactors[i], U, 1, 2));
981 Inc(i);
982 end;
983end;
984
985
986
987{Exams-------------------------------------------------------------------------}
988procedure LoadXAMResultsItems(Dest: TStrings);
989begin
990 tCallV(Dest,'ORWPCE GET SET OF CODES',['9000010.13','.04','1']);
991end;
992
993procedure LoadHistLocations(Dest: TStrings);
994var
995 i, j, tlen: integer;
996 tmp: string;
997
998begin
999 tCallV(Dest,'ORQQPX GET HIST LOCATIONS',[]);
1000 for i := 0 to (Dest.Count - 1) do
1001 begin
1002 tmp := MixedCase(dest[i]);
1003 j := pos(', ',tmp);
1004 tlen := length(tmp);
1005 if(j > 0) and (j < (tlen - 2)) and (pos(tmp[j+2],UpperCaseLetters) > 0) and
1006 (pos(tmp[j+3],LowerCaseLetters)>0) and ((j = (tlen-3)) or (pos(tmp[j+4],LowerCaseLetters)=0)) then
1007 tmp[j+3] := UpCase(tmp[j+3]);
1008 if(tlen > 1) then
1009 begin
1010 if(pos(tmp[tlen],Digits) > 0) and (pos(tmp[tlen-1],Digits)=0) then
1011 insert(' ',tmp, tlen);
1012 end;
1013 dest[i] := tmp;
1014 end;
1015end;
1016
1017procedure ListExamsSections(Dest: TStrings);
1018{ return Sections in format: ListIndex^SectionName (sections begin with '^') }
1019var
1020 i: Integer;
1021 x: string;
1022begin
1023 if (uLastLocation <> uEncLocation) then LoadEncounterForm;
1024 for i := 0 to uExams.Count - 1 do if CharAt(uExams[i], 1) = U then
1025 begin
1026 x := Piece(uExams[i], U, 2);
1027 if Length(x) = 0 then x := '<No Section Name>';
1028 Dest.Add(IntToStr(i) + U + Piece(uExams[i], U, 2) + U + x);
1029 end;
1030end;
1031
1032
1033procedure ListExamsCodes(Dest: TStrings; SectionIndex: Integer);
1034{ return PatientEds within section in format: procedure <TAB> CPT code <TAB><TAB> CPT code}
1035var
1036 i: Integer;
1037begin
1038 Dest.Clear;
1039 i := SectionIndex + 1; // first line after the section name
1040 while (i < uExams.Count) and (CharAt(uExams[i], 1) <> U) do
1041 begin
1042 Dest.Add(Pieces(uExams[i], U, 1, 2));
1043 Inc(i);
1044 end;
1045end;
1046
1047
1048
1049
1050
1051{------------------------------------------------------------------------------}
1052function EligbleConditions: TSCConditions;
1053{ return a record listing the conditions for which a patient is eligible }
1054var
1055 x: string;
1056begin
1057 x := sCallV('ORWPCE SCSEL', [Patient.DFN, Encounter.DateTime, uEncLocation]);
1058 with Result do
1059 begin
1060 SCAllow := Piece(Piece(x, ';', 1), U, 1) = '1';
1061 SCDflt := Piece(Piece(x, ';', 1), U, 2) = '1';
1062 AOAllow := Piece(Piece(x, ';', 2), U, 1) = '1';
1063 AODflt := Piece(Piece(x, ';', 2), U, 2) = '1';
1064 IRAllow := Piece(Piece(x, ';', 3), U, 1) = '1';
1065 IRDflt := Piece(Piece(x, ';', 3), U, 2) = '1';
1066 ECAllow := Piece(Piece(x, ';', 4), U, 1) = '1';
1067 ECDflt := Piece(Piece(x, ';', 4), U, 2) = '1';
1068 MSTAllow := Piece(Piece(x, ';', 5), U, 1) = '1';
1069 MSTDflt := Piece(Piece(x, ';', 5), U, 2) = '1';
1070 HNCAllow := Piece(Piece(x, ';', 6), U, 1) = '1';
1071 HNCDflt := Piece(Piece(x, ';', 6), U, 2) = '1';
1072 CVAllow := Piece(Piece(x, ';', 7), U, 1) = '1';
1073 CVDflt := Piece(Piece(x, ';', 7), U, 2) = '1';
1074 end;
1075end;
1076
1077procedure ListSCDisabilities(Dest: TStrings);
1078{ return text listing a patient's rated disabilities and % service connected }
1079begin
1080 CallV('ORWPCE SCDIS', [Patient.DFN]);
1081 Dest.Assign(RPCBrokerV.Results);
1082end;
1083
1084procedure LoadPCEDataForNote(Dest: TStrings; ANoteIEN: Integer; VStr: string);
1085begin
1086 if(ANoteIEN < 1) then
1087 CallV('ORWPCE PCE4NOTE', [ANoteIEN, Patient.DFN, VStr])
1088 else
1089 CallV('ORWPCE PCE4NOTE', [ANoteIEN]);
1090 Dest.Assign(RPCBrokerV.Results);
1091end;
1092
1093function GetVisitIEN(NoteIEN: Integer): string;
1094begin
1095 if(NoteIEN < 1) then
1096 CallV('ORWPCE GET VISIT', [NoteIEN, Patient.DFN, Encounter.VisitStr])
1097 else
1098 CallV('ORWPCE GET VISIT', [NoteIEN]);
1099 if(RPCBrokerV.Results.Count > 0) then
1100 Result := RPCBrokerV.Results[0]
1101 else
1102 Result := '0';
1103end;
1104
1105procedure SavePCEData(PCEList: TStringList; ANoteIEN, ALocation: integer);
1106begin
1107 CallV('ORWPCE SAVE', [PCEList, ANoteIEN, ALocation]);
1108end;
1109
1110{-----------------------------------------------------------------------------}
1111
1112function DataHasCPTCodes(AList: TStrings): boolean;
1113var
1114 i: integer;
1115 vl: string;
1116
1117begin
1118 if(not assigned(uHasCPT)) then
1119 uHasCPT := TStringList.Create;
1120 Result := FALSE;
1121 i := 0;
1122 while(i < AList.Count) do
1123 begin
1124 vl := uHasCPT.Values[AList[i]];
1125 if(vl = '1') then
1126 begin
1127 Result := TRUE;
1128 exit;
1129 end
1130 else
1131 if(vl = '0') then
1132 AList.Delete(i)
1133 else
1134 inc(i);
1135 end;
1136 if(AList.Count > 0) then
1137 begin
1138 with RPCBrokerV do
1139 begin
1140 ClearParameters := True;
1141 RemoteProcedure := 'ORWPCE HASCPT';
1142 Param[0].PType := list;
1143 with Param[0] do
1144 begin
1145 for i := 0 to AList.Count-1 do
1146 Mult[inttostr(i+1)] := AList[i];
1147 end;
1148 CallBroker;
1149 for i := 0 to RPCBrokerV.Results.Count-1 do
1150 begin
1151 if(Piece(RPCBrokerV.Results[i],'=',2) = '1') then
1152 begin
1153 Result := TRUE;
1154 break;
1155 end;
1156 end;
1157 uHasCPT.AddStrings(RPCBrokerV.Results);
1158 end;
1159 end;
1160end;
1161
1162function GetAskPCE(Loc: integer): TAskPCE;
1163begin
1164 if(uAPUser <> User.DUZ) or (uAPLoc <> Loc) then
1165 begin
1166 uAPUser := User.DUZ;
1167 uAPLoc := Loc;
1168 uAPAsk := TAskPCE(StrToIntDef(sCallV('ORWPCE ASKPCE', [User.DUZ, Loc]), 0));
1169 end;
1170 Result := uAPAsk;
1171end;
1172
1173function HasVisit(const ANoteIEN, ALocation: integer; const AVisitDate: TFMDateTime): Integer;
1174begin
1175 Result := StrToIntDef(sCallV('ORWPCE HASVISIT', [ANoteIEN, Patient.DFN, ALocation, AVisitDate]), -1);
1176end;
1177
1178{-----------------------------------------------------------------------------}
1179function CheckActivePerson(provider:String;DateTime:TFMDateTime): boolean;
1180var
1181 RetVal: String;
1182begin
1183 Callv('ORWPCE ACTIVE PROV',[provider,FloatToStr(DateTime)]);
1184 retval := RPCBrokerV.Results[0];
1185 if StrToInt(RetVal) = 1 then result := true
1186 else result := false;
1187end;
1188
1189function ForcePCEEntry(Loc: integer): boolean;
1190begin
1191 if(Loc <> uLastForceLoc) then
1192 begin
1193 uLastForce := (sCallV('ORWPCE FORCE', [User.DUZ, Loc]) = '1');
1194 uLastForceLoc := Loc;
1195 end;
1196 Result := uLastForce;
1197end;
1198
1199procedure LoadcboOther(Dest: TStrings; Location, fOtherApp: Integer);
1200{loads items into combo box on Immunization screen}
1201var
1202 IEN, RPC: string;
1203 TmpSL: TORStringList;
1204 i, j, idx, typ: integer;
1205
1206begin
1207 TmpSL := TORStringList.Create;
1208 try
1209 Idx := 0;
1210 case fOtherApp of
1211 PCE_IMM: begin typ := 1; RPC := 'ORWPCE GET IMMUNIZATION TYPE'; end;
1212 PCE_SK: begin typ := 2; RPC := 'ORWPCE GET SKIN TEST TYPE'; end;
1213 PCE_PED: begin typ := 3; RPC := 'ORWPCE GET EDUCATION TOPICS'; end;
1214 PCE_HF: begin typ := 4; RPC := 'ORWPCE GET HEALTH FACTORS TY'; Idx := 1; end;
1215 PCE_XAM: begin typ := 5; RPC := 'ORWPCE GET EXAM TYPE'; end;
1216 else begin typ := 0; RPC := ''; end;
1217 end;
1218 if typ > 0 then
1219 begin
1220 if idx = 0 then
1221 tCallV(TmpSL,RPC,[nil])
1222 else
1223 tCallV(TmpSL,RPC,[idx]);
1224 CallV('ORWPCE GET EXCLUDED', [Location, Typ]);
1225 for i := 0 to RPCBrokerV.Results.Count-1 do
1226 begin
1227 IEN := piece(RPCBrokerV.Results[i],U,2);
1228 idx := TmpSL.IndexOfPiece(IEN);
1229 if idx >= 0 then
1230 begin
1231 TmpSL.Delete(idx);
1232 if fOtherApp = PCE_HF then
1233 begin
1234 j := 0;
1235 while (j < TmpSL.Count) do
1236 begin
1237 if IEN = Piece(TmpSL[J],U,4) then
1238 TmpSL.Delete(j)
1239 else
1240 inc(j);
1241 end;
1242 end;
1243 end;
1244 end;
1245 end;
1246 Dest.Assign(TmpSL);
1247 finally
1248 TmpSL.Free;
1249 end;
1250end;
1251
1252{
1253function SetRPCEncouterInfo(PCEData: TPCEData): boolean;
1254begin
1255 if (SetRPCEncLocation(PCEData.location) = False) or (SetRPCEncDateTime(PCEData.DateTime) = False) then
1256 result := False
1257 else result := True;
1258end;
1259}
1260
1261function SetRPCEncLocation(Loc: Integer): boolean;
1262begin
1263 uEncLocation := Loc;
1264 Result := (uEncLocation <> 0);
1265end;
1266
1267{
1268function SetRPCEncDateTime(DT: TFMDateTime): boolean;
1269begin
1270 uEncDateTime := 0.0;
1271 result := False;
1272 uEncDateTime := DT;
1273 if uEncDateTime > 0.0 then result := true;
1274end;
1275}
1276
1277function PCERPCEncLocation: integer;
1278begin
1279 result := uEncLocation;
1280end;
1281
1282{
1283function PCERPCEncDateTime: TFMDateTime;
1284begin
1285 result := uEncDateTime;
1286end;
1287}
1288
1289function GetLocSecondaryVisitCode(Loc: integer): char;
1290begin
1291 if (Loc <> uLastIsClinicLoc) then
1292 begin
1293 uLastIsClinicLoc := Loc;
1294 uLastIsClinic := (sCallV('ORWPCE ISCLINIC', [Loc]) = '1');
1295 end;
1296 if uLastIsClinic then
1297 Result := 'I'
1298 else
1299 Result := 'D';
1300end;
1301
1302function GAFOK: boolean;
1303begin
1304 if(not uGAFOKCalled) then
1305 begin
1306 uGAFOK := (sCallV('ORWPCE GAFOK', []) = '1');
1307 uGAFOKCalled := TRUE;
1308 end;
1309 Result := uGAFOK;
1310end;
1311
1312function MHClinic(const Location: integer): boolean;
1313begin
1314 if GAFOK then
1315 Result := (sCallV('ORWPCE MHCLINIC', [Location]) = '1')
1316 else
1317 Result := FALSE;
1318end;
1319
1320procedure RecentGAFScores(const Limit: integer);
1321begin
1322 if(GAFOK) then
1323 begin
1324 with RPCBrokerV do
1325 begin
1326 ClearParameters := True;
1327 RemoteProcedure := 'ORWPCE LOADGAF';
1328 Param[0].PType := list;
1329 with Param[0] do
1330 begin
1331 Mult['"DFN"'] := Patient.DFN;
1332 Mult['"LIMIT"'] := IntToStr(Limit);
1333 end;
1334 CallBroker;
1335 end;
1336 end;
1337end;
1338
1339function SaveGAFScore(const Score: integer; GAFDate: TFMDateTime; Staff: Int64): boolean;
1340begin
1341 Result := FALSE;
1342 if(GAFOK) then
1343 begin
1344 with RPCBrokerV do
1345 begin
1346 ClearParameters := True;
1347 RemoteProcedure := 'ORWPCE SAVEGAF';
1348 Param[0].PType := list;
1349 with Param[0] do
1350 begin
1351 Mult['"DFN"'] := Patient.DFN;
1352 Mult['"GAF"'] := IntToStr(Score);
1353 Mult['"DATE"'] := FloatToStr(GAFDate);
1354 Mult['"STAFF"'] := IntToStr(Staff);
1355 end;
1356 CallBroker;
1357 end;
1358 if(RPCBrokerV.Results.Count > 0) and
1359 (RPCBrokerV.Results[0] = '1') then
1360 Result := TRUE;
1361 end;
1362end;
1363
1364function GAFURL: string;
1365begin
1366 if(not uGAFURLChecked) then
1367 begin
1368 uGAFURL := sCallV('ORWPCE GAFURL', []);
1369 uGAFURLChecked := TRUE;
1370 end;
1371 Result := uGAFURL;
1372end;
1373
1374function MHTestsOK: boolean;
1375begin
1376 if(not uMHOKChecked) then
1377 begin
1378 uMHOK := (sCallV('ORWPCE MHTESTOK', []) = '1');
1379 uMHOKChecked := TRUE;
1380 end;
1381 Result := uMHOK;
1382end;
1383
1384function MHTestAuthorized(Test: string): boolean;
1385begin
1386 Result := (sCallV('ORWPCE MH TEST AUTHORIZED', [Test, User.DUZ]) = '1');
1387end;
1388
1389function AnytimeEncounters: boolean;
1390begin
1391 if uAnytimeEnc < 0 then
1392 uAnytimeEnc := ord(sCallV('ORWPCE ANYTIME', []) = '1');
1393 Result := BOOLEAN(uAnytimeEnc);
1394end;
1395
1396function AutoCheckout(Loc: integer): boolean;
1397begin
1398 if(uLastChkOutLoc <> Loc) then
1399 begin
1400 uLastChkOutLoc := Loc;
1401 uLastChkOut := (sCallV('ORWPCE ALWAYS CHECKOUT', [Loc]) = '1');
1402 end;
1403 Result := uLastChkOut;
1404end;
1405
1406{ encounter capture functions ------------------------------------------------ }
1407
1408function RequireExposures(ANote, ATitle: Integer): Boolean; {*RAB 3/22/99*}
1409{ returns true if a progress note should require the expossure questions to be answered }
1410begin
1411 if ANote <= 0
1412 then Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', ['0', ATitle]), U, 15) = '1'
1413 else Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]), U, 15) = '1';
1414end;
1415
1416function PromptForWorkload(ANote, ATitle: Integer; VisitCat: Char; StandAlone: boolean): Boolean;
1417{ returns true if a progress note should prompt for capture of encounter }
1418var
1419 X: string;
1420
1421begin
1422 Result := FALSE;
1423 if (VisitCat <> 'A') and (VisitCat <> 'I') and (VisitCat <> 'T') then exit;
1424 if ANote <= 0 then
1425 X := sCallV('TIU GET DOCUMENT PARAMETERS', ['0', ATitle])
1426 else
1427 X := sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]);
1428 if(Piece(X, U, 14) = '1') then exit; // Suppress DX/CPT param is TRUE - don't ask
1429 if StandAlone then
1430 Result := TRUE
1431 else
1432 Result := (Piece(X, U, 16) = '1'); // Check Ask DX/CPT param
1433end;
1434
1435function IsCancelOrNoShow(ANote: integer): boolean;
1436begin
1437 Result := (sCallV('ORWPCE CXNOSHOW', [ANote]) = '0');
1438end;
1439
1440function IsNonCountClinic(ALocation: integer): boolean;
1441begin
1442 Result := (sCallV('ORWPCE1 NONCOUNT', [ALocation]) = '1');
1443end;
1444
1445function DefaultProvider(ALocation: integer; AUser: Int64; ADate: TFMDateTime;
1446 ANoteIEN: integer): string;
1447begin
1448 Result := sCallV('TIU GET DEFAULT PROVIDER', [ALocation, AUser, ADate, ANoteIEN]);
1449end;
1450
1451function IsUserAProvider(AUser: Int64; ADate: TFMDateTime): boolean;
1452begin
1453 Result := (sCallV('TIU IS USER A PROVIDER?', [AUser, ADate]) = '1');
1454end;
1455
1456//function HNCOK: boolean;
1457//begin
1458// if uHNCOK < 0 then
1459// uHNCOK := ord(sCallV('ORWPCE HNCOK', []) = '1');
1460// Result := boolean(uHNCOK);
1461//end;
1462
1463initialization
1464 uLastLocation := 0;
1465 uVTypeLastLoc := 0;
1466 uVTypeLastDate := 0;
1467 uDiagnoses := TStringList.Create;
1468 uExams := TStringList.Create;
1469 uHealthFactors := TStringList.Create;
1470 uImmunizations := TStringList.Create;
1471 uPatientEds := TStringList.Create;
1472 uProcedures := TStringList.Create;
1473 uSkinTests := TStringList.Create;
1474 uVisitTypes := TStringList.Create;
1475 uVTypeForLoc := TStringList.Create;
1476 uProblems := TStringList.Create;
1477
1478finalization
1479 uDiagnoses.Free;
1480 uExams.Free;
1481 uHealthFactors.Free;
1482 uImmunizations.Free;
1483 uPatientEds.Free;
1484 uProcedures.Free;
1485 uSkinTests.free;
1486 uVisitTypes.Free;
1487 uVTypeForLoc.Free;
1488 uProblems.Free;
1489 KillObj(@uModifiers);
1490 KillObj(@uHasCPT);
1491
1492end.
Note: See TracBrowser for help on using the repository browser.