source: cprs/trunk/CPRS-Chart/Encounter/rPCE.pas@ 1806

Last change on this file since 1806 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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