source: cprs/branches/foia-cprs/CPRS-Chart/Orders/rODLab.pas@ 1806

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

Uploading from OR_30_258

File size: 5.0 KB
Line 
1unit rODLab;
2
3interface
4
5uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs ;
6
7 { Laboratory Ordering Calls }
8function ODForLab(Location: integer; Division: integer = 0): TStrings;
9procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;
10procedure LoadSamples(LoadList: TStringList) ;
11procedure LoadSpecimens(SpecimenList: TStringList) ;
12function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;
13function CalcStopDate(Text: string): string ;
14function MaxDays(Location, Schedule: integer): integer;
15function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;
16function ImmediateCollectTimes: TStrings;
17function LabCollectFutureDays(Location: integer; Division: integer = 0): integer;
18function GetDefaultImmCollTime: TFMDateTime;
19function ValidImmCollTime(CollTime: TFMDateTime): string;
20function GetOneCollSamp(LRFSAMP: integer): TStrings;
21function GetOneSpecimen(LRFSPEC: integer): string;
22procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
23function GetLastCollectionTime: string;
24procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
25procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
26procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
27function StatAllowed(PatientID: string): boolean;
28procedure GetBloodComponents(Dest: TStrings);
29
30implementation
31
32uses rODBase;
33(* fODBase, rODBase, fODLab;*)
34
35procedure GetBloodComponents(Dest: TStrings);
36begin
37 tCallV(Dest, 'ORWDXVB COMPORD', []);
38end;
39
40function StatAllowed(PatientID: string): boolean;
41begin
42 Result := (StrToInt(sCallV('ORWDXVB STATALOW',[PatientID])) > 0);
43end;
44
45procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
46begin
47 tCallV(Dest, 'ORWDXVB RAW', [PatientID, ATests]);
48end;
49
50procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
51begin
52 tCallV(Dest, 'ORWDXVB RESULTS', [PatientID, ATests]);
53end;
54
55procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
56begin
57 tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]);
58end;
59
60function ODForLab(Location, Division: integer): TStrings;
61{ Returns init values for laboratory dialog. The results must be used immediately. }
62begin
63 CallV('ORWDLR32 DEF', [Location,Division]);
64 Result := RPCBrokerV.Results;
65end;
66
67procedure LoadLabTestData(LoadData: TStringList; LabTestIEN: string) ;
68begin
69 tCallV(LoadData, 'ORWDLR32 LOAD', [LabTestIEN]);
70end ;
71
72procedure LoadSamples(LoadList: TStringList) ;
73begin
74 tCallV(LoadList, 'ORWDLR32 ALLSAMP', [nil]);
75end ;
76
77function SubsetOfSpecimens(const StartFrom: string; Direction: Integer): TStrings;
78begin
79 Callv('ORWDLR32 ALLSPEC',[StartFrom, Direction]);
80 Result := RPCBrokerV.Results;
81end ;
82
83procedure LoadSpecimens(SpecimenList: TStringList) ;
84begin
85 tCallV(SpecimenList, 'ORWDLR32 ABBSPEC', [nil]);
86end ;
87
88function CalcStopDate(Text: string): string ;
89begin
90 Result := sCallV('ORWDLR32 STOP', [Text]);
91end ;
92
93function MaxDays(Location, Schedule: integer): integer;
94begin
95 Result := StrToInt(sCallV('ORWDLR32 MAXDAYS',[Location, Schedule]));
96end;
97
98function IsLabCollectTime(ADateTime: TFMDateTime; Location: integer): boolean;
99begin
100 Result := (StrToInt(sCallV('ORWDLR32 LAB COLL TIME',[ADateTime,Location])) > 0);
101end;
102
103function LabCollectFutureDays(Location: integer; Division: integer): integer;
104begin
105 Result := StrToInt(sCallV('ORWDLR33 FUTURE LAB COLLECTS',[Location, Division]));
106end;
107
108function ImmediateCollectTimes: TStrings;
109begin
110 CallV('ORWDLR32 IMMED COLLECT',[nil]);
111 Result := RPCBrokerV.Results;
112end;
113
114function GetDefaultImmCollTime: TFMDateTime;
115begin
116 CallV('ORWDLR32 IC DEFAULT',[nil]);
117 Result := StrToFloat(Piece(RPCBrokerV.Results[0], U, 1));
118end;
119
120function ValidImmCollTime(CollTime: TFMDateTime): string;
121begin
122 CallV('ORWDLR32 IC VALID',[CollTime]);
123 Result := RPCBrokerV.Results[0];
124end;
125
126function GetOneCollSamp(LRFSAMP: integer): TStrings;
127begin
128 CallV('ORWDLR32 ONE SAMPLE', [LRFSAMP]);
129 Result := RPCBrokerV.Results;
130end;
131
132function GetOneSpecimen(LRFSPEC: integer): string;
133begin
134 Result := sCallV('ORWDLR32 ONE SPECIMEN', [LRFSPEC]);
135end;
136
137function GetLastCollectionTime: string;
138begin
139 Result := sCallV('ORWDLR33 LASTTIME', [nil]);
140end
141;
142procedure GetLabTimesForDate(Dest: TStrings; LabDate: TFMDateTime; Location: integer);
143var
144 Prefix: string;
145 i: integer;
146begin
147 CallV('ORWDLR32 GET LAB TIMES', [LabDate, Location]);
148 with Dest do
149 begin
150 Assign(RPCBrokerV.Results);
151 if (Count > 0) and (Piece(Strings[0], U, 1) <> '-1') then
152 for i := 0 to Count - 1 do
153 begin
154 if Strings[i] > '1159' then Prefix := 'PM Collection: ' else Prefix := 'AM Collection: ';
155 Strings[i] := Strings[i] + U + Prefix + Copy(Strings[i], 1, 2) + ':' + Copy(Strings[i], 3, 2);
156 end;
157 end;
158end;
159
160end.
Note: See TracBrowser for help on using the repository browser.