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