source: cprs/trunk/CPRS-Chart/Orders/rODAllergy.pas@ 486

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

Initial Upload of Official WV CPRS 1.0.26.76
File size: 12.0 KB
RevLine 
[456]1unit rODAllergy;
2
3{$O-}
4
5interface
6
7uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc ;
8
9type
10 TAllergyRec = record
11 Changed: boolean;
12 IEN: Integer;
13 CausativeAgent: string;
14 AllergyType: string;
15 NatureOfReaction: string;
16 SignsSymptoms: TStringList;
17 Originator: int64;
18 OriginatorName: string;
19 Originated: TFMDateTime;
20 Comments: TStringList;
21 IDBandMarked: TStringList;
22 ChartMarked: TStringList;
23 Verifier: int64;
24 VerifierName: string;
25 Verified: boolean;
26 VerifiedDateTime: TFMDateTime;
27 EnteredInError: boolean;
28 DateEnteredInError: TFMDateTime;
29 UserEnteringInError: int64;
30 ErrorComments: TStringList;
31 Observed_Historical: string;
32 Observations: TStringList;
33 ReactionDate: TFMDateTime;
34 Severity: string;
35 NoKnownAllergies: Boolean;
36 NewComments: TStringList;
37 end;
38
39 TARTPatchInstalled = record
40 PatchInstalled: boolean;
41 PatchChecked: boolean;
42 end;
43
44 TGMRASiteParams = record
45 MarkIDBandFlag: Boolean;
46 OriginatorCommentsRequired: Boolean;
47 ErrorCommentsEnabled: Boolean;
48 ParamsSet: Boolean;
49 end;
50
51 TARTClinUser = record
52 IsClinUser: boolean;
53 ReasonFailed: string;
54 AccessChecked: boolean;
55 end;
56
57function SearchForAllergies(StringToMatch: string): TStrings;
58function SubsetofSymptoms(const StartFrom: string; Direction: Integer): TStrings;
59function ODForAllergies: TStrings;
60function GetCWADInfo(const DFN: string): string;
61function SaveAllergy(EditRec: TAllergyRec): string;
62function LoadAllergyForEdit(AllergyIEN: integer): TAllergyRec;
63function SendARTBulletin(AFreeTextEntry: string; AComment: TStringList): string;
64function RPCEnterNKAForPatient: string;
65
66// site parameter functions
67function ARTPatchInstalled: boolean;
68function GetSiteParams: TGMRASiteParams;
69function MarkIDBand: boolean;
70function RequireOriginatorComments: boolean;
71function EnableErrorComments: boolean;
72function IsARTClinicalUser(var AMessage: string): boolean;
73
74implementation
75
76const
77 NO_YES: array[Boolean] of string = ('NO', 'YES');
78
79var
80 uARTPatchInstalled: TARTPatchInstalled;
81 uGMRASiteParams: TGMRASiteParams;
82 uARTClinUser: TARTClinUser;
83
84function ODForAllergies: TStrings;
85begin
86 CallV('ORWDAL32 DEF',[nil]);
87 Result := RPCBrokerV.Results;
88end;
89
90function SearchForAllergies(StringToMatch: string): TStrings;
91begin
92 CallV('ORWDAL32 ALLERGY MATCH',[StringToMatch]);
93 Result := RPCBrokerV.Results;
94end;
95
96function SubsetofSymptoms(const StartFrom: string; Direction: Integer): TStrings;
97begin
98 Callv('ORWDAL32 SYMPTOMS',[StartFrom, Direction]);
99 Result := RPCBrokerV.Results;
100end;
101
102function GetCWADInfo(const DFN: string): string;
103begin
104 Result := sCallV('ORWPT CWAD',[DFN]);
105end;
106
107function LoadAllergyForEdit(AllergyIEN: integer): TAllergyRec;
108var
109 Dest: TStringList;
110 EditRec: TAllergyRec;
111 x: string;
112begin
113 Dest := TStringList.Create;
114 try
115 tCallV(Dest, 'ORWDAL32 LOAD FOR EDIT', [AllergyIEN]) ;
116 if Piece(RPCBrokerV.Results[0], U, 1) <> '-1' then
117 begin
118 with EditRec do
119 begin
120 Changed := False;
121 IEN := AllergyIEN;
122 CausativeAgent := ExtractDefault(Dest, 'CAUSATIVE AGENT');
123 AllergyType := ExtractDefault(Dest, 'ALLERGY TYPE');
124 NatureOfReaction := ExtractDefault(Dest, 'NATURE OF REACTION');
125 SignsSymptoms := TStringList.Create;
126 ExtractItems(SignsSymptoms, Dest, 'SIGN/SYMPTOMS');
127 MixedCaseByPiece(SignsSymptoms, U, 4);
128 x := ExtractDefault(Dest, 'ORIGINATOR');
129 Originator := StrToInt64Def(Piece(x, U, 1), 0);
130 OriginatorName := Piece(x, U, 2);
131 Originated := StrToFMDateTime(ExtractDefault(Dest, 'ORIGINATED'));
132 Comments := TStringList.Create;
133 ExtractText(Comments, Dest, 'COMMENTS');
134 IDBandMarked := TStringList.Create;
135 ExtractItems(IDBandMarked, Dest, 'ID BAND MARKED');
136 ChartMarked := TStringList.Create;
137 ExtractItems(ChartMarked, Dest, 'CHART MARKED');
138 //x := ExtractDefault(Dest, 'VERIFIER');
139 //Verifier := StrToInt64Def(Piece(x, U, 1), 0);
140 //VerifierName := Piece(x, U, 2);
141 //x := ExtractDefault(Dest, 'VERIFIED');
142 //Verified := Piece(x, U, 1) = 'YES';
143 //if Verified then
144 // VerifiedDateTime := StrToFMDateTime(Piece(x, U, 2));
145 x := ExtractDefault(Dest, 'ENTERED IN ERROR');
146 EnteredInError := Piece(x, U, 1) = 'YES';
147 DateEnteredInError := StrToFloatDef(Piece(x, U, 2), 0);
148 UserEnteringInError := StrToInt64Def(Piece(x, U, 3), 0);
149 ErrorComments := TStringList.Create;
150 Observed_Historical := ExtractDefault(Dest, 'OBS/HIST');
151 Observations := TStringList.Create;
152 ExtractText(Observations, Dest, 'OBSERVATIONS');
153 //ReactionDate := StrToFMDateTime(Piece(ExtractDefault(Dest, 'REACTDT'), U, 3));
154 //Severity := Piece(ExtractDefault(Dest, 'SEVERITY'), U, 3);
155 NoKnownAllergies := (StrToIntDef(Piece(ExtractDefault(Dest, 'NKA'), U, 3), 0) > 0);
156 NewComments := TStringList.Create;
157 end;
158 end
159 else
160 EditRec.IEN := -1;
161 Result := EditRec;
162 finally
163 Dest.Free;
164 end;
165end;
166
167function SaveAllergy(EditRec: TAllergyRec): string;
168var
169 i: integer;
170begin
171 with RPCBrokerV, EditRec do
172 begin
173 ClearParameters := True;
174 RemoteProcedure := 'ORWDAL32 SAVE ALLERGY';
175 Param[0].PType := literal;
176 Param[0].Value := IntToStr(IEN);
177 Param[1].PType := literal;
178 Param[1].Value := Patient.DFN;
179 Param[2].PType := list;
180 with Param[2] do
181 begin
182 if NoKnownAllergies then
183 Mult['"GMRANKA"'] := NO_YES[NoKnownAllergies];
184 if CausativeAgent <> '' then
185 Mult['"GMRAGNT"'] := CausativeAgent;
186 if AllergyType <> '' then
187 Mult['"GMRATYPE"'] := AllergyType ;
188 if NatureOfReaction <> '' then
189 Mult['"GMRANATR"'] := NatureOfReaction ;
190 if Originator > 0 then
191 Mult['"GMRAORIG"'] := IntToStr(Originator);
192 if Originated > 0 then
193 Mult['"GMRAORDT"'] := FloatToStr(Originated);
194 with SignsSymptoms do if Count > 0 then
195 begin
196 Mult['"GMRASYMP",0'] := IntToStr(Count);
197 for i := 0 to Count - 1 do
198 Mult['"GMRASYMP",' + IntToStr(i+1)] := Pieces(Strings[i], U, 1, 5);
199 end;
200 //if Verified then
201 // Mult['"GMRAVER"'] := NO_YES[Verified];
202 //if Verifier > 0 then
203 // Mult['"GMRAVERF"'] := IntToStr(Verifier);
204 //if VerifiedDateTime > 0 then
205 // Mult['"GMRAVERD"'] := FloatToStr(VerifiedDateTime);
206 if EnteredInError then
207 begin
208 Mult['"GMRAERR"'] := NO_YES[EnteredInError];
209 Mult['"GMRAERRBY"'] := IntToStr(UserEnteringInError);
210 Mult['"GMRAERRDT"'] := FloatToStr(DateEnteredInError);
211 with ErrorComments do if Count > 0 then
212 begin
213 Mult['"GMRAERRCMTS",0'] := IntToStr(Count);
214 for i := 0 to Count - 1 do
215 Mult['"GMRAERRCMTS",' + IntToStr(i+1)] := Strings[i];
216 end;
217 end ;
218 with ChartMarked do if Count > 0 then
219 begin
220 Mult['"GMRACHT",0'] := IntToStr(Count);
221 for i := 0 to Count - 1 do
222 Mult['"GMRACHT",' + IntToStr(i+1)] := Strings[i];
223 end;
224 with IDBandMarked do if Count > 0 then
225 begin
226 Mult['"GMRAIDBN",0'] := IntToStr(Count);
227 for i := 0 to Count - 1 do
228 Mult['"GMRAIDBN",' + IntToStr(i+1)] := Strings[i];
229 end;
230 if Length(Observed_Historical) > 0 then
231 Mult['"GMRAOBHX"'] := Observed_Historical;
232 if ReactionDate > 0 then
233 Mult['"GMRARDT"'] := FloatToStr(ReactionDate);
234 if Length(Severity) > 0 then
235 Mult['"GMRASEVR"'] := Severity;
236 with NewComments do if Count > 0 then
237 begin
238 Mult['"GMRACMTS",0'] := IntToStr(Count);
239 for i := 0 to Count - 1 do
240 Mult['"GMRACMTS",' + IntToStr(i+1)] := Strings[i];
241 end;
242 end;
243 CallBroker;
244 Result := Results[0];
245 end;
246end;
247
248function RPCEnterNKAForPatient: string;
249begin
250 with RPCBrokerV do
251 begin
252 ClearParameters := True;
253 RemoteProcedure := 'ORWDAL32 SAVE ALLERGY';
254 Param[0].PType := literal;
255 Param[0].Value := '0';
256 Param[1].PType := literal;
257 Param[1].Value := Patient.DFN;
258 Param[2].PType := list;
259 with Param[2] do
260 Mult['"GMRANKA"'] := 'YES';
261 CallBroker;
262 Result := Results[0];
263 end;
264end;
265
266function SendARTBulletin(AFreeTextEntry: string; AComment: TStringList): string;
267var
268 i: integer;
269begin
270 with RPCBrokerV do
271 begin
272 ClearParameters := True;
273 RemoteProcedure := 'ORWDAL32 SEND BULLETIN';
274 Param[0].PType := literal;
275 Param[0].Value := User.DUZ;
276 Param[1].PType := literal;
277 Param[1].Value := Patient.DFN;
278 Param[2].PType := literal;
279 Param[2].Value := AFreeTextEntry;
280 if AComment.Count > 0 then with Param[3] do
281 begin
282 PType := list;
283 for i := 0 to AComment.Count - 1 do
284 Mult[IntToStr(Succ(i)) + ',0'] := AComment[i];
285 Mult['0'] := '^^' + IntToStr(AComment.Count);
286 end;
287 CallBroker;
288 Result := Results[0];
289 end;
290end;
291
292// Site parameter functions
293
294function ARTPatchInstalled: boolean;
295begin
296 with uARTPatchInstalled do
297 if not PatchChecked then
298 begin
299 PatchInstalled := ServerHasPatch('GMRA*4.0*21');
300 PatchChecked := True;
301 end;
302 Result := uARTPatchInstalled.PatchInstalled;
303end;
304
305function GetSiteParams: TGMRASiteParams;
306var
307 x: string;
308begin
309 with uGMRASiteParams do
310 if not ParamsSet then
311 begin
312 x := sCallV('ORWDAL32 SITE PARAMS', [nil]);
313 MarkIDBandFlag := (Piece(x, U, 5) <> '0');
314 OriginatorCommentsRequired := (Piece(x, U, 4) = '1');
315 ErrorCommentsEnabled := (Piece(x, U, 11) = '1');
316 ParamsSet := True;
317 end;
318 Result := uGMRASiteParams;
319end;
320
321function MarkIDBand: boolean;
322begin
323 Result := GetSiteParams.MarkIDBandFlag;
324end;
325
326function RequireOriginatorComments: boolean;
327begin
328 Result := GetSiteParams.OriginatorCommentsRequired;
329end;
330
331function EnableErrorComments: boolean;
332begin
333 Result := GetSiteParams.ErrorCommentsEnabled;
334end;
335
336(*function IsARTClinicalUser(var AMessage: string): boolean;
337const
338 TX_NO_AUTH = 'You are not authorized to perform this action.' + CRLF +
339 'Either the ORES or ORELSE key is required.';
340begin
341 Result := (User.UserClass > UC_CLERK); // User has ORES or ORELSE key
342 if not Result then AMessage := TX_NO_AUTH else AMessage := '';
343end;*)
344
345function IsARTClinicalUser(var AMessage: string): boolean;
346const
347 TX_NO_AUTH = 'You are not authorized to perform this action.' + CRLF;
348var
349 x: string;
350begin
351 with uARTClinUser do
352 begin
353 if not AccessChecked then
354 begin
355 x := sCallV('ORWDAL32 CLINUSER',[nil]);
356 IsClinUser := (Piece(x, U, 1) = '1');
357 if not IsClinUser then ReasonFailed := TX_NO_AUTH + Piece(x, U, 2) else ReasonFailed := '';
358 AccessChecked := True;
359 end;
360 Result := IsClinUser;
361 AMessage := ReasonFailed ;
362 end;
363end;
364
365end.
Note: See TracBrowser for help on using the repository browser.