Module

rDCSumm

Path

C:\CPRS\CPRS30\rDCSumm.pas

Last Modified

7/15/2014 3:26:44 PM

Initialization Code

initialization
  // nothing for now

Finalization Code

finalization
  if uDCSummTitles <> nil then uDCSummTitles.Free;
  if uDCSummPrefs <> nil then uDCSummPrefs.Free;

end.

Units Used in Interface

Name Comments
rCore -
rTIU -
uConst -
uCore -
uDCSumm -
uTIU -

Procedures

Name Owner Declaration Scope Comments
ActOnDCDocument - procedure ActOnDCDocument(var AuthSts: TActionRec; IEN: Integer; const ActionName: string); Interfaced
Data Retrieval
Data Retrieval ---------------------------------------------------------------------------
ChangeAttending - procedure ChangeAttending(IEN: integer; AnAttending: int64); Interfaced -
DeleteDCDocument - procedure DeleteDCDocument(var DeleteSts: TActionRec; IEN: Integer; const Reason: string); Interfaced
Data Storage
Data Updates ----------------------------------------------------------------------------- 

 delete a TIU document given the internal entry number, return reason if unable to delete
GetDCSummForEdit - procedure GetDCSummForEdit(var EditRec: TEditDCSummRec; IEN: Integer); Interfaced
Retrieves internal/external values for Discharge Summary fields & loads them into EditRec
  Fields: Title:.01, RefDate:1301, Author:1204, Cosigner:1208, Subject:1701, Location:1205
ListDCSummTitlesShort - procedure ListDCSummTitlesShort(Dest: TStrings); Interfaced Returns the user defined list (short list) of Discharge Summary titles
ListSummsForTree - procedure ListSummsForTree(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime; Person: int64; OccLim: Integer; SortAscending: Boolean); Interfaced
Procedure ListDischargeSummaries(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
  Person: int64; OccLim: Integer; SortAscending: Boolean);
procedure ListDischargeSummaries(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
  Person: int64; OccLim: Integer; SortAscending: Boolean);
{retrieves existing progress notes for a patient according to the parameters passed in
  Pieces: IEN^Title^FMDateOfNote^Patient^Author^Location^Status^Visit
  Return: IEN^ExDateOfNote^Title, Location, Author }
var
  i: Integer;
  x: string;
  SortSeq: Char;
begin
  if SortAscending then SortSeq := 'A' else SortSeq := 'D';
  //if OccLim = 0 then OccLim := MaxSummsReturned;
  CallV('TIU DOCUMENTS BY CONTEXT',
         [CLS_DC_SUMM, Context, Patient.DFN, Early, Late, Person, OccLim, SortSeq]);
  with RPCBrokerV do
  begin
    for i := 0 to Results.Count - 1 do
    begin
      x := Results[i];
      if Copy(Piece(x, U, 9), 1, 4) = '    ' then SetPiece(x, U, 9, 'Dis: ');
      x := Piece(x, U, 1) + U + FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3)))
        + U + Piece(x, U, 2) + ', ' + Piece(x, U, 6) + ', ' + Piece(Piece(x, U, 5), ';', 2) +
        '  (' + Piece(x,U,7) + '), ' + Piece(x, U, 8) + ', ' + Piece(x, U, 9) +
        U + Piece(x, U, 3) + U + Piece(x, U, 11);
      Results[i] := x;
    end; {for}
    FastAssign(RPCBrokerV.Results, Dest);
  end; {with}
end;

 retrieves existing discharge summaries for a patient according to the parameters passed in
LoadDCSummPrefs - procedure LoadDCSummPrefs; Global TIU Preferences -------------------------------------------------------------------------
LoadDCSummTitles - procedure LoadDCSummTitles; Global Discharge Summary Titles --------------------------------------------------------------------
PutDCAddendum - procedure PutDCAddendum(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; AddendumTo: Integer); Interfaced
Create a new addendum for note identified in AddendumTo, returns IEN of new document
  load broker directly since there isn't a good way to set up multiple subscript arrays 

var
  i: Integer;
PutEditedDCSumm - procedure PutEditedDCSumm(var UpdatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; NoteIEN: Integer); Interfaced
Update the fields and content of the note identified in NoteIEN, returns 1 if successful
  load broker directly since there isn't a good way to set up mutilple subscript arrays 

var
  i: Integer;
PutNewDCSumm - procedure PutNewDCSumm(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec); Interfaced
Create a new discharge summary with the data in DCSummRec and return its internal entry number
  load broker directly since there isn't a good way to set up multiple subscript arrays 

var
  i: Integer;
ResetDCSummPreferences - procedure ResetDCSummPreferences; Interfaced TIU Preferences
ResetDCSummTitles - procedure ResetDCSummTitles; Interfaced Discharge Summary Titles
SaveCurrentDCSummContext - procedure SaveCurrentDCSummContext(AContext: TTIUContext) ; Interfaced -
SignDCDocument - procedure SignDCDocument(var SignSts: TActionRec; IEN: Integer; const ESCode: string); Interfaced Update signed status of a TIU document, return reason if signature is not accepted

Functions

Name Owner Declaration Scope Comments
AllowMultipleSummsPerAdmission - function AllowMultipleSummsPerAdmission(ANote, AType: Integer): Boolean; Interfaced Returns true if a discharge summary must be released
DfltDCSummTitle - function DfltDCSummTitle: Integer; Interfaced Returns the IEN of the user defined default Discharge Summary title (if any)
DfltDCSummTitleName - function DfltDCSummTitleName: string; Interfaced Returns the name of the user defined default Discharge Summary title (if any)
FindDT - function FindDT(const FieldID: string): TFMDateTime; Local -
FindExt - function FindExt(const FieldID: string): string; Local -
FindInt - function FindInt(const FieldID: string): Integer; Local -
FindInt64 - function FindInt64(const FieldID: string): Int64; Local -
GetAttending - function GetAttending(const DFN: string): string; Interfaced
DFN*
DFN*
GetCurrentDCSummContext - function GetCurrentDCSummContext: TTIUContext; Interfaced -
GetDischargeDate - function GetDischargeDate(const DFN: string; AdmitDateTime: string): string; Interfaced
DFN*
DFN*
LoadDCUrgencies - function LoadDCUrgencies: TStrings; Interfaced -
RequireMASVerification - function RequireMASVerification(ANote, AType: Integer): Boolean; Interfaced Returns true if a discharge summary must be verified
RequireRelease - function RequireRelease(ANote, AType: Integer): Boolean; Interfaced Returns true if a discharge summary must be released
ReturnMaxDCSumms - function ReturnMaxDCSumms: Integer; Interfaced -
SortDCSummsAscending - function SortDCSummsAscending: Boolean; Interfaced Returns true if Discharge Summarys should be sorted from oldest to newest (chronological)
SubSetOfDCSummTitles - function SubSetOfDCSummTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings; Interfaced
Returns a pointer to a list of Discharge Summary titles (for use in a long list box) -
  The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE
  the next broker call!

Global Variables

Name Type Declaration Comments
uDCSummPrefs TDCSummPrefs uDCSummPrefs: TDCSummPrefs; -
uDCSummTitles TDCSummTitles uDCSummTitles: TDCSummTitles; -

Constants

Name Declaration Scope Comments
CLS_DC_SUMM 244 Interfaced -
FN_HOSPITAL_LOCATION 44 Interfaced -
FN_NEW_PERSON 200 Interfaced -
TIU_ST_UNREL 3 Interfaced -
TIU_ST_UNSIG 5 Interfaced -
TIU_ST_UNVER 4 Interfaced -


Module Source

1     unit rDCSumm;
2     
3     interface
4     
5     uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, rTIU, uConst, uTIU, uDCSumm;
6     
7     
8     { Discharge Summary Titles }
9     procedure ResetDCSummTitles;
10    function  DfltDCSummTitle: Integer;
11    function  DfltDCSummTitleName: string;
12    procedure ListDCSummTitlesShort(Dest: TStrings);
13    function SubSetOfDCSummTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
14    
15    { TIU Preferences }
16    procedure ResetDCSummPreferences;
17    function  ReturnMaxDCSumms: Integer;
18    function  SortDCSummsAscending: Boolean;
19    function  GetCurrentDCSummContext: TTIUContext;
20    procedure SaveCurrentDCSummContext(AContext: TTIUContext) ;
21    
22    { Data Retrieval }
23    procedure ActOnDCDocument(var AuthSts: TActionRec; IEN: Integer; const ActionName: string);
24    (*procedure ListDischargeSummaries(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
25      Person: int64; OccLim: Integer; SortAscending: Boolean);*)
26    procedure ListSummsForTree(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
27      Person: int64; OccLim: Integer; SortAscending: Boolean);
28    procedure GetDCSummForEdit(var EditRec: TEditDCSummRec; IEN: Integer);
29    function  LoadDCUrgencies: TStrings;
30    function  GetAttending(const DFN: string): string;  //*DFN*
31    function  GetDischargeDate(const DFN: string; AdmitDateTime: string): string;  //*DFN*
32    function RequireRelease(ANote, AType: Integer): Boolean;
33    function RequireMASVerification(ANote, AType: Integer): Boolean;
34    function AllowMultipleSummsPerAdmission(ANote, AType: Integer): Boolean;
35    
36    { Data Storage }
37    procedure DeleteDCDocument(var DeleteSts: TActionRec; IEN: Integer; const Reason: string);
38    procedure SignDCDocument(var SignSts: TActionRec; IEN: Integer; const ESCode: string); 
39    procedure PutNewDCSumm(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec);
40    procedure PutDCAddendum(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; AddendumTo: 
41    Integer);
42    procedure PutEditedDCSumm(var UpdatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; NoteIEN: 
43    Integer);
44    procedure ChangeAttending(IEN: integer; AnAttending: int64);
45    
46    const
47      CLS_DC_SUMM = 244;
48      FN_HOSPITAL_LOCATION = 44;
49      FN_NEW_PERSON = 200;
50      TIU_ST_UNREL = 3;
51      TIU_ST_UNVER = 4;
52      TIU_ST_UNSIG = 5;
53    
54    implementation
55    
56    var
57      uDCSummTitles: TDCSummTitles;
58      uDCSummPrefs: TDCSummPrefs;
59    
60    { Discharge Summary Titles  -------------------------------------------------------------------- }
61    procedure LoadDCSummTitles;
62    { private - called one time to set up the uNoteTitles object }
63    var
64      x: string;
65    begin
66      if uDCSummTitles <> nil then Exit;
67      CallV('TIU PERSONAL TITLE LIST', [User.DUZ, CLS_DC_SUMM]);
68      RPCBrokerV.Results.Insert(0, '~SHORT LIST');  // insert so can call ExtractItems
69      uDCSummTitles := TDCSummTitles.Create;
70      ExtractItems(uDCSummTitles.ShortList, RPCBrokerV.Results, 'SHORT LIST');
71      x := ExtractDefault(RPCBrokerV.Results, 'SHORT LIST');
72      uDCSummTitles.DfltTitle := StrToIntDef(Piece(x, U, 1), 0);
73      uDCSummTitles.DfltTitleName := Piece(x, U, 2);
74    end;
75    
76    procedure ResetDCSummTitles;
77    begin
78      if uDCSummTitles <> nil then
79        begin
80          uDCSummTitles.Free;
81          uDCSummTitles := nil;
82          LoadDCSummTitles;
83        end;
84    end;
85    
86    function DfltDCSummTitle: Integer;
87    { returns the IEN of the user defined default Discharge Summary title (if any) }
88    begin
89      if uDCSummTitles = nil then LoadDCSummTitles;
90      Result := uDCSummTitles.DfltTitle;
91    end;
92    
93    function DfltDCSummTitleName: string;
94    { returns the name of the user defined default Discharge Summary title (if any) }
95    begin
96      if uDCSummTitles = nil then LoadDCSummTitles;
97      Result := uDCSummTitles.DfltTitleName;
98    end;
99    
100   procedure ListDCSummTitlesShort(Dest: TStrings);
101   { returns the user defined list (short list) of Discharge Summary titles }
102   begin
103     if uDCSummTitles = nil then LoadDCSummTitles;
104     FastAddStrings(uDCSummTitles.ShortList, Dest);
105     if uDCSummTitles.ShortList.Count > 0 then
106     begin
107       Dest.Add('0^________________________________________________________________________');
108       Dest.Add('0^ ');
109     end;
110   end;
111   
112   function SubSetOfDCSummTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
113   { returns a pointer to a list of Discharge Summary titles (for use in a long list box) -
114     The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE
115     the next broker call! }
116   begin
117     if IDNoteTitlesOnly then
118       CallV('TIU LONG LIST OF TITLES', [CLS_DC_SUMM, StartFrom, Direction, IDNoteTitlesOnly])
119     else
120       CallV('TIU LONG LIST OF TITLES', [CLS_DC_SUMM, StartFrom, Direction]);
121     //MixedCaseList(RPCBrokerV.Results);
122     Result := RPCBrokerV.Results;
123   end;
124   
125   { TIU Preferences  ------------------------------------------------------------------------- }
126   
127   procedure LoadDCSummPrefs;
128   { private - creates DCSummPrefs object for reference throughout the session }
129   var
130     x: string;
131   begin
132     uDCSummPrefs := TDCSummPrefs.Create;
133     with uDCSummPrefs do
134     begin
135       x := sCallV('TIU GET PERSONAL PREFERENCES', [User.DUZ]);
136       DfltLoc := StrToIntDef(Piece(x, U, 2), 0);
137       DfltLocName := ExternalName(DfltLoc, FN_HOSPITAL_LOCATION);
138       SortAscending := Piece(x, U, 4) = 'A';
139       MaxSumms := StrToIntDef(Piece(x, U, 10), 0);
140       x := GetAttending(Patient.DFN);
141       DfltCosigner := StrToInt64Def(Piece(x, U, 1), 0);
142       DfltCosignerName := ExternalName(DfltCosigner, FN_NEW_PERSON);
143       AskCosigner := User.DUZ <> DfltCosigner;
144     end;
145   end;
146   
147   procedure ResetDCSummPreferences;
148   begin
149     if uDCSummPrefs <> nil then
150       begin
151         uDCSummPrefs.Free;
152         uDCSummPrefs := nil;
153         LoadDCSummPrefs;
154       end;
155   end;
156   
157   function ReturnMaxDCSumms: Integer;
158   begin
159     if uDCSummPrefs = nil then LoadDCSummPrefs;
160     Result := uDCSummPrefs.MaxSumms;
161     if Result = 0 then Result := 100;
162   end;
163   
164   function SortDCSummsAscending: Boolean;
165   { returns true if Discharge Summarys should be sorted from oldest to newest (chronological) }
166   begin
167     if uDCSummPrefs = nil then LoadDCSummPrefs;
168     Result := uDCSummPrefs.SortAscending;
169   end;
170   
171   { Data Retrieval --------------------------------------------------------------------------- }
172   
173   procedure ActOnDCDocument(var AuthSts: TActionRec; IEN: Integer; const ActionName: string);
174   var
175     x: string;
176   begin
177     if not (IEN > 0) then
178     begin
179       AuthSts.Success := True;
180       AuthSts.Reason := '';
181       Exit;
182     end;
183     x := sCallV('TIU AUTHORIZATION', [IEN, ActionName]);
184     AuthSts.Success := Piece(x, U, 1) = '1';
185     AuthSts.Reason  := Piece(x, U, 2);
186   end;
187   
188   (*procedure ListDischargeSummaries(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
189     Person: int64; OccLim: Integer; SortAscending: Boolean);
190   { retrieves existing progress notes for a patient according to the parameters passed in
191     Pieces: IEN^Title^FMDateOfNote^Patient^Author^Location^Status^Visit
192     Return: IEN^ExDateOfNote^Title, Location, Author }
193   var
194     i: Integer;
195     x: string;
196     SortSeq: Char;
197   begin
198     if SortAscending then SortSeq := 'A' else SortSeq := 'D';
199     //if OccLim = 0 then OccLim := MaxSummsReturned;
200     CallV('TIU DOCUMENTS BY CONTEXT',
201            [CLS_DC_SUMM, Context, Patient.DFN, Early, Late, Person, OccLim, SortSeq]);
202     with RPCBrokerV do
203     begin
204       for i := 0 to Results.Count - 1 do
205       begin
206         x := Results[i];
207         if Copy(Piece(x, U, 9), 1, 4) = '    ' then SetPiece(x, U, 9, 'Dis: ');
208         x := Piece(x, U, 1) + U + FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3)))
209           + U + Piece(x, U, 2) + ', ' + Piece(x, U, 6) + ', ' + Piece(Piece(x, U, 5), ';', 2) +
210           '  (' + Piece(x,U,7) + '), ' + Piece(x, U, 8) + ', ' + Piece(x, U, 9) +
211           U + Piece(x, U, 3) + U + Piece(x, U, 11);
212         Results[i] := x;
213       end; {for}
214       FastAssign(RPCBrokerV.Results, Dest);
215     end; {with}
216   end;*)
217   
218   procedure ListSummsForTree(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
219     Person: int64; OccLim: Integer; SortAscending: Boolean);
220   { retrieves existing discharge summaries for a patient according to the parameters passed in}
221   var
222     SortSeq: Char;
223   const
224     SHOW_ADDENDA = True;
225   begin
226     if SortAscending then SortSeq := 'A' else SortSeq := 'D';
227     if Context > 0 then
228       begin
229         CallV('TIU DOCUMENTS BY CONTEXT', [CLS_DC_SUMM, Context, Patient.DFN, Early, Late, Person, OccLim, SortSeq, SHOW_ADDENDA]);
230         FastAssign(RPCBrokerV.Results, Dest);
231       end;
232   end;
233   
234   procedure GetDCSummForEdit(var EditRec: TEditDCSummRec; IEN: Integer);
235   { retrieves internal/external values for Discharge Summary fields & loads them into EditRec
236     Fields: Title:.01, RefDate:1301, Author:1204, Cosigner:1208, Subject:1701, Location:1205 }
237   var
238     i, j: Integer;
239   
240     function FindDT(const FieldID: string): TFMDateTime;
241     var
242       i: Integer;
243     begin
244       Result := 0;
245       with RPCBrokerV do for i := 0 to Results.Count - 1 do
246         if Piece(Results[i], U, 1) = FieldID then
247         begin
248           Result := MakeFMDateTime(Piece(Results[i], U, 2));
249           Break;
250         end;
251     end;
252   
253     function FindExt(const FieldID: string): string;
254     var
255       i: Integer;
256     begin
257       Result := '';
258       with RPCBrokerV do for i := 0 to Results.Count - 1 do
259         if Piece(Results[i], U, 1) = FieldID then
260         begin
261           Result := Piece(Results[i], U, 3);
262           Break;
263         end;
264     end;
265   
266     function FindInt(const FieldID: string): Integer;
267     var
268       i: Integer;
269     begin
270       Result := 0;
271       with RPCBrokerV do for i := 0 to Results.Count - 1 do
272         if Piece(Results[i], U, 1) = FieldID then
273         begin
274           Result := StrToIntDef(Piece(Results[i], U, 2), 0);
275           Break;
276         end;
277     end;
278   
279     function FindInt64(const FieldID: string): Int64;
280     var
281       i: Integer;
282     begin
283       Result := 0;
284       with RPCBrokerV do for i := 0 to Results.Count - 1 do
285         if Piece(Results[i], U, 1) = FieldID then
286         begin
287           Result := StrToInt64Def(Piece(Results[i], U, 2), 0);
288           Break;
289         end;
290     end;
291   
292   
293   begin
294     CallV('TIU LOAD RECORD FOR EDIT', [IEN, '.01;.06;.07;.09;1202;1205;1208;1209;1301;1302;1307;1701']);
295     FillChar(EditRec, SizeOf(EditRec), 0);
296     with EditRec do
297     begin
298       Title                 := FindInt('.01');
299       TitleName             := FindExt('.01');
300       AdmitDateTime         := FindDT('.07');
301       DischargeDateTime     := FindDT('1301');
302       UrgencyName           := FindExt('.09');
303       Urgency               := Copy(UrgencyName,1,1);
304       Dictator              := FindInt64('1202');
305       DictatorName          := FindExt('1202');
306       Cosigner              := FindInt64('1208');
307       CosignerName          := FindExt('1208');
308       DictDateTime          := FindDT('1307');
309       Attending             := FindInt64('1209');
310       AttendingName         := FindExt('1209');
311       Transcriptionist      := FindInt64('1302');
312       TranscriptionistName  := FindExt('1302');
313       Location              := FindInt('1205');
314       LocationName          := FindExt('1205');
315       if Title = TYP_ADDENDUM then Addend := FindInt('.06');
316       with RPCBrokerV do
317       begin
318         for i := 0 to Results.Count - 1 do if Results[i] = '$TXT' then break;
319         for j := i downto 0 do Results.Delete(j);
320         // -------------------- v19.1 (RV) LOST NOTES?----------------------------
321         //Lines := Results;   'Lines' is being overwritten by subsequent Broker calls
322         if not Assigned(Lines) then Lines := TStringList.Create;
323         FastAssign(RPCBrokerV.Results, Lines);
324         // -----------------------------------------------------------------------
325       end;
326     end;
327   end;
328   
329   function LoadDCUrgencies: TStrings;
330   var
331     i: integer;
332   begin
333     CallV('TIU GET DS URGENCIES',[nil]);
334     with RPCBrokerV do
335       for i := 0 to Results.Count-1 do
336         Results[i] := MixedCase(UpperCase(Results[i]));
337     Result := RPCBrokerV.Results;
338   end;
339   
340   { Data Updates ----------------------------------------------------------------------------- }
341   
342   procedure DeleteDCDocument(var DeleteSts: TActionRec; IEN: Integer; const Reason: string);
343   { delete a TIU document given the internal entry number, return reason if unable to delete }
344   var
345     x: string;
346   begin
347     x := sCallV('TIU DELETE RECORD', [IEN, Reason]);
348     DeleteSts.Success := Piece(x, U, 1) = '0';
349     DeleteSts.Reason  := Piece(x, U, 2);
350   end;
351   
352   procedure SignDCDocument(var SignSts: TActionRec; IEN: Integer; const ESCode: string);
353   { update signed status of a TIU document, return reason if signature is not accepted }
354   var
355     x: string;
356   begin
357   (*  with RPCBrokerV do                           // temp - to insure sign doesn't go interactive
358     begin
359       ClearParameters := True;
360       RemoteProcedure := 'TIU UPDATE RECORD';
361       Param[0].PType := literal;
362       Param[0].Value := IntToStr(IEN);            
363       Param[1].PType := list;
364       with Param[1] do Mult['.11']  := '0';       // **** block removed in v19.1 - {RV} ****
365       CallBroker;
366     end;                                         // temp - end*)
367     x := sCallV('TIU SIGN RECORD', [IEN, ESCode]);
368     SignSts.Success := Piece(x, U, 1) = '0';
369     SignSts.Reason  := Piece(x, U, 2);
370   end;
371   
372   procedure PutNewDCSumm(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec);
373   { create a new discharge summary with the data in DCSummRec and return its internal entry number
374     load broker directly since there isn't a good way to set up multiple subscript arrays }
375   (*var
376     i: Integer;*)
377   var
378     ErrMsg: string;
379   begin
380     with RPCBrokerV do
381     begin
382       ClearParameters := True;
383       RemoteProcedure := 'TIU CREATE RECORD';
384       Param[0].PType := literal;
385       Param[0].Value := Patient.DFN;  //*DFN*
386       Param[1].PType := literal;
387       Param[1].Value := IntToStr(DCSummRec.Title);
388       Param[2].PType := literal;
389       Param[2].Value := '';
390       Param[3].PType := literal;
391       Param[3].Value := '';
392       Param[4].PType := literal;
393       Param[4].Value := '';
394       Param[5].PType := list;
395       with Param[5] do
396       begin
397         Mult['.07']    := FloatToStr(DCSummRec.AdmitDateTime);
398         Mult['.09']    := DCSummRec.Urgency;
399         Mult['1202']   := IntToStr(DCSummRec.Dictator);
400         Mult['1205']   := IntToStr(Encounter.Location);
401         Mult['1301']   := FloatToStr(DCSummRec.DischargeDateTime);
402         Mult['1307']   := FloatToStr(DCSummRec.DictDateTime);
403         if DCSummRec.Cosigner > 0 then
404           begin
405             Mult['1208'] := IntToStr(DCSummRec.Cosigner);
406             Mult['1506'] := '1';
407           end
408         else
409           begin
410             Mult['1208'] := '';
411             Mult['1506'] := '0';
412           end  ;
413         Mult['1209']   := IntToStr(DCSummRec.Attending);
414         Mult['1302']   := IntToStr(DCSummRec.Transcriptionist);
415         if DCSummRec.IDParent > 0 then Mult['2101'] := IntToStr(DCSummRec.IDParent);
416   (*      if DCSummRec.Lines <> nil then
417           for i := 0 to DCSummRec.Lines.Count - 1 do
418             Mult['"TEXT",' + IntToStr(i+1) + ',0'] := FilteredString(DCSummRec.Lines[i]);*)
419       end;
420       Param[6].PType := literal;
421       Param[6].Value := DCSummRec.VisitStr;
422       Param[7].PType := literal;
423       Param[7].Value := '1';  // suppress commit logic
424       CallBroker;
425       CreatedDoc.IEN := StrToIntDef(Piece(Results[0], U, 1), 0);
426       CreatedDoc.ErrorText := Piece(Results[0], U, 2);
427     end;
428     if ( DCSummRec.Lines <> nil ) and ( CreatedDoc.IEN <> 0 ) then
429     begin
430       SetText(ErrMsg, DCSummRec.Lines, CreatedDoc.IEN, 1);
431       if ErrMsg <> '' then
432       begin
433         CreatedDoc.IEN := 0;
434         CreatedDoc.ErrorText := ErrMsg;
435       end;
436     end;
437   end;
438   
439   procedure PutDCAddendum(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; AddendumTo: 
440   Integer);
441   { create a new addendum for note identified in AddendumTo, returns IEN of new document
442     load broker directly since there isn't a good way to set up multiple subscript arrays }
443   (*var
444     i: Integer;*)
445   var
446     ErrMsg: string;
447   begin
448     with RPCBrokerV do
449     begin
450       ClearParameters := True;
451       RemoteProcedure := 'TIU CREATE ADDENDUM RECORD';
452       Param[0].PType := literal;
453       Param[0].Value := IntToStr(AddendumTo);
454       Param[1].PType := list;
455       with Param[1] do
456       begin
457         Mult['.09']    := DCSummRec.Urgency;
458         Mult['1202']   := IntToStr(DCSummRec.Dictator);
459         Mult['1301']   := FloatToStr(DCSummRec.DischargeDateTime);
460         Mult['1307']   := FloatToStr(DCSummRec.DictDateTime);
461         if DCSummRec.Cosigner > 0 then
462           begin
463             Mult['1208'] := IntToStr(DCSummRec.Cosigner);
464             Mult['1506'] := '1';
465           end
466         else
467           begin
468             Mult['1208'] := '';
469             Mult['1506'] := '0';
470           end  ;
471   (*      if DCSummRec.Lines <> nil then
472           for i := 0 to DCSummRec.Lines.Count - 1 do
473             Mult['"TEXT",' + IntToStr(i+1) + ',0'] := FilteredString(DCSummRec.Lines[i]);*)
474       end;
475       Param[2].PType := literal;
476       Param[2].Value := '1';  // suppress commit logic
477       CallBroker;
478       CreatedDoc.IEN := StrToIntDef(Piece(Results[0], U, 1), 0);
479       CreatedDoc.ErrorText := Piece(Results[0], U, 2);
480     end;
481     if ( DCSummRec.Lines <> nil ) and ( CreatedDoc.IEN <> 0 ) then
482     begin
483       SetText(ErrMsg, DCSummRec.Lines, CreatedDoc.IEN, 1);
484       if ErrMsg <> '' then
485       begin
486         CreatedDoc.IEN := 0;
487         CreatedDoc.ErrorText := ErrMsg;
488       end;
489     end;
490   end;
491   
492   procedure PutEditedDCSumm(var UpdatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; NoteIEN:
493   Integer);
494   { update the fields and content of the note identified in NoteIEN, returns 1 if successful
495     load broker directly since there isn't a good way to set up mutilple subscript arrays }
496   (*var
497     i: Integer;*)
498   var
499     ErrMsg: string;
500   begin
501     // First, file field data
502     with RPCBrokerV do
503     begin
504       ClearParameters := True;
505       RemoteProcedure := 'TIU UPDATE RECORD';
506       Param[0].PType := literal;
507       Param[0].Value := IntToStr(NoteIEN);
508       Param[1].PType := list;
509       with Param[1] do
510       begin
511         if DCSummRec.Addend = 0 then
512           begin
513             Mult['.01']  := IntToStr(DCSummRec.Title);
514             //Mult['.11']  := BOOLCHAR[DCSummRec.NeedCPT];  //  **** removed in v19.1  {RV} ****
515           end;
516         if (DCSummRec.Status in [TIU_ST_UNREL(*, TIU_ST_UNVER*)]) then Mult['.05'] := IntToStr(DCSummRec.Status);
517         Mult['1202']   := IntToStr(DCSummRec.Dictator);
518         Mult['1209']   := IntToStr(DCSummRec.Attending);
519         Mult['1301']   := FloatToStr(DCSummRec.DischargeDateTime);  
520         if DCSummRec.Cosigner > 0 then
521           begin
522             Mult['1208'] := IntToStr(DCSummRec.Cosigner);
523             Mult['1506'] := '1';
524           end
525         else
526           begin
527             Mult['1208'] := '';
528             Mult['1506'] := '0';
529           end  ;
530   (*      for i := 0 to DCSummRec.Lines.Count - 1 do
531           Mult['"TEXT",' + IntToStr(i+1) + ',0'] := FilteredString(DCSummRec.Lines[i]);*)
532       end;
533       CallBroker;
534       UpdatedDoc.IEN := StrToIntDef(Piece(Results[0], U, 1), 0);
535       UpdatedDoc.ErrorText := Piece(Results[0], U, 2);
536     end;
537   
538     if UpdatedDoc.IEN <= 0 then              //v22.12 - RV
539     //if UpdatedDoc.ErrorText <> '' then    //v22.5 - RV
540       begin
541         UpdatedDoc.ErrorText := UpdatedDoc.ErrorText + #13#10 + #13#10 + 'Document #:  ' + IntToStr(NoteIEN);
542         exit;  
543       end;
544   
545       // next, if no error, file document body
546     SetText(ErrMsg, DCSummRec.Lines, NoteIEN, 0);
547     if ErrMsg <> '' then
548     begin
549       UpdatedDoc.IEN := 0;
550       UpdatedDoc.ErrorText := ErrMsg;
551     end;
552   end;
553   
554   function GetAttending(const DFN: string): string;  //*DFN*
555   begin
556     CallV('ORQPT ATTENDING/PRIMARY',[DFN]);
557     Result := Piece(RPCBrokerV.Results[0],';',1);
558   end;
559   
560   function GetDischargeDate(const DFN: string; AdmitDateTime: string): string;  //*DFN*
561   begin
562     CallV('ORWPT DISCHARGE',[DFN, AdmitDateTime]);
563     Result := RPCBrokerV.Results[0];
564   end;
565   
566   function RequireRelease(ANote, AType: Integer): Boolean;
567   { returns true if a discharge summary must be released }
568   begin
569     if ANote > 0 then
570       Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]), U, 2) = '1'
571     else
572       Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [0, AType]), U, 2) = '1';
573   end;
574   
575   function RequireMASVerification(ANote, AType: Integer): Boolean;
576   { returns true if a discharge summary must be verified }
577   var
578     AValue: integer;
579   begin
580     Result := False;
581     if ANote > 0 then
582       AValue := StrToIntDef(Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]), U, 3), 0)
583     else
584       AValue := StrToIntDef(Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [0, AType]), U, 3), 0);
585     case AValue of
586       0:  Result := False;   //  NO
587       1:  Result := True;    //  ALWAYS
588       2:  Result := False;   //  UPLOAD ONLY
589       3:  Result := True;    //  DIRECT ENTRY ONLY
590     end;
591   end;
592   
593   function AllowMultipleSummsPerAdmission(ANote, AType: Integer): Boolean;
594   { returns true if a discharge summary must be released }
595   begin
596     if ANote > 0 then
597       Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]), U, 10) = '1'
598     else
599       Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [0, AType]), U, 10) = '1';
600   end;
601   
602   procedure ChangeAttending(IEN: integer; AnAttending: int64);
603   var
604     AttendingIsNotCurrentUser: boolean;
605   begin
606     AttendingIsNotCurrentUser := (AnAttending <> User.DUZ);
607     with RPCBrokerV do
608     begin
609       ClearParameters := True;
610       RemoteProcedure := 'TIU UPDATE RECORD';
611       Param[0].PType := literal;
612       Param[0].Value := IntToStr(IEN);
613       Param[1].PType := list;
614       with Param[1] do
615         begin
616           Mult['1209']   := IntToStr(AnAttending);
617           if AttendingIsNotCurrentUser then
618           begin
619             Mult['1208'] := IntToStr(AnAttending);
620             Mult['1506'] := '1';
621           end
622         else
623           begin
624             Mult['1208'] := '';
625             Mult['1506'] := '0';
626           end  ;
627         end;
628       CallBroker;
629     end;
630   end;
631   
632   function GetCurrentDCSummContext: TTIUContext;
633   var
634     x: string;
635     AContext: TTIUContext;
636   begin
637     x := sCallV('ORWTIU GET DCSUMM CONTEXT', [User.DUZ]) ;
638     with AContext do
639       begin
640         Changed       := True;
641         BeginDate     := Piece(x, ';', 1);
642         EndDate       := Piece(x, ';', 2);
643         Status        := Piece(x, ';', 3);
644         if (StrToIntDef(Status, 0) < 1) or (StrToIntDef(Status, 0) > 5) then Status := '1';
645         Author        := StrToInt64Def(Piece(x, ';', 4), 0);
646         MaxDocs       := StrToIntDef(Piece(x, ';', 5), 0);
647         ShowSubject   := StrToIntDef(Piece(x, ';', 6), 0) > 0;   //TIU PREFERENCE??
648         SortBy        := Piece(x, ';', 7);                       //TIU PREFERENCE??
649         ListAscending := StrToIntDef(Piece(x, ';', 8), 0) > 0;
650         TreeAscending := StrToIntDef(Piece(x, ';', 9), 0) > 0;   //TIU PREFERENCE??
651         GroupBy       := Piece(x, ';', 10);
652         SearchField   := Piece(x, ';', 11);
653         KeyWord       := Piece(x, ';', 12);
654         Filtered      := (Keyword <> '');
655       end;
656     Result := AContext;
657   end;
658   
659   procedure SaveCurrentDCSummContext(AContext: TTIUContext) ;
660   var
661     x: string;
662   begin
663     with AContext do
664       begin
665         SetPiece(x, ';', 1, BeginDate);
666         SetPiece(x, ';', 2, EndDate);
667         SetPiece(x, ';', 3, Status);
668         if Author > 0 then
669           SetPiece(x, ';', 4, IntToStr(Author))
670         else
671           SetPiece(x, ';', 4, '');
672         SetPiece(x, ';', 5, IntToStr(MaxDocs));
673         SetPiece(x, ';', 6, BOOLCHAR[ShowSubject]);       //TIU PREFERENCE??
674         SetPiece(x, ';', 7, SortBy);                      //TIU PREFERENCE??
675         SetPiece(x, ';', 8, BOOLCHAR[ListAscending]);
676         SetPiece(x, ';', 9, BOOLCHAR[TreeAscending]);     //TIU PREFERENCE??
677         SetPiece(x, ';', 10, GroupBy);
678         SetPiece(x, ';', 11, SearchField);
679         SetPiece(x, ';', 12, KeyWord);
680       end;
681     CallV('ORWTIU SAVE DCSUMM CONTEXT', [x]);
682   end;
683   
684   initialization
685     // nothing for now
686   
687   finalization
688     if uDCSummTitles <> nil then uDCSummTitles.Free;
689     if uDCSummPrefs <> nil then uDCSummPrefs.Free;
690   
691   end.

Module Calls (2 levels)


rDCSumm
 ├rCore
 │ └uCore
 ├uCore...
 ├rTIU
 │ ├rCore...
 │ ├uCore...
 │ ├uConst
 │ ├uTIU
 │ └rMisc
 ├uConst
 ├uTIU
 └uDCSumm

Module Called-By (2 levels)


         rDCSumm
       fDCSumm┤ 
      fFrame┤ │ 
  fPrintList┤ │ 
     fReview┤ │ 
fAddlSigners┘ │ 
  fDCSummProps┤ 
  fDCSumm...┘ │ 
 fOptionsNotes┤ 
    fOptions┘ │ 
fOptionsTitles┘ 
 fOptions...┘