Module

fOrdersOnChart

Path

C:\CPRS\CPRS30\Orders\fOrdersOnChart.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -

Units Used in Implementation

Name Comments
fClinicWardMeds -
fFrame -
fOrdersPrint -
fRptBox -
rCore -
rODLab -
rOrders -
uConst -
uCore -
uOrders -

Classes

Name Comments
TfrmOnChartOrders -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmOnChartOrders procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmOnChartOrders procedure cmdOKClick(Sender: TObject); Public/Published -
FormCreate TfrmOnChartOrders procedure FormCreate(Sender: TObject); Public/Published -
lstOrdersDrawItem TfrmOnChartOrders procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
lstOrdersMeasureItem TfrmOnChartOrders procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); Public/Published -
Panel2Resize TfrmOnChartOrders procedure Panel2Resize(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
ExecuteOnChartOrders - function ExecuteOnChartOrders(SelectedList: TList): Boolean; Interfaced -
FindOrderText - function FindOrderText(const AnID: string): string; Local -

Constants

Name Declaration Scope Comments
TC_SAVERR 'Error Saving Order' Global -
TX_SAVERR1 'The error, ' Global -
TX_SAVERR2 ', occurred while trying to save:' + CRLF + CRLF Global -


Module Source

1     unit fOrdersOnChart;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
8     
9     type
10      TfrmOnChartOrders = class(TfrmAutoSz)
11        Panel2: TPanel;
12        Label1: TLabel;
13        lstOrders: TCaptionListBox;
14        Panel1: TPanel;
15        cmdOK: TButton;
16        cmdCancel: TButton;
17        procedure FormCreate(Sender: TObject);
18        procedure cmdOKClick(Sender: TObject);
19        procedure cmdCancelClick(Sender: TObject);
20        procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
21          var AHeight: Integer);
22        procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
23          Rect: TRect; State: TOwnerDrawState);
24        procedure Panel2Resize(Sender: TObject);
25      private
26        OKPressed: Boolean;
27      end;
28    
29    function ExecuteOnChartOrders(SelectedList: TList): Boolean;
30    
31    implementation
32    
33    {$R *.DFM}
34    
35    uses rCore, rOrders, uConst, fOrdersPrint, uOrders, fFrame, uCore,
36      fClinicWardMeds, rODLab, fRptBox;
37    
38    const
39      TX_SAVERR1 = 'The error, ';
40      TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
41      TC_SAVERR  = 'Error Saving Order';
42    
43    function ExecuteOnChartOrders(SelectedList: TList): Boolean;
44    var
45      frmOnChartOrders: TfrmOnChartOrders;
46      i, PrintLoc: Integer;
47      SignList: TStringList;
48      OrderText: string;
49      AList: TStringList;
50    
51      function FindOrderText(const AnID: string): string;
52      var
53        i: Integer;
54      begin
55        Result := '';
56        with SelectedList do for i := 0 to Count - 1 do
57          with TOrder(Items[i]) do if ID = AnID then
58          begin
59            Result := Text;
60            Break;
61          end;
62      end;
63    
64    begin
65      Result := False;
66      PrintLoc := 0;
67      if SelectedList.Count = 0 then Exit;
68      frmOnChartOrders := TfrmOnChartOrders.Create(Application);
69      try
70        ResizeFormToFont(TForm(frmOnChartOrders));
71        with SelectedList do for i := 0 to Count - 1 do
72          frmOnChartOrders.lstOrders.Items.Add(TOrder(Items[i]).Text);
73        frmOnChartOrders.ShowModal;
74        if frmOnChartOrders.OKPressed then
75        begin
76          Result := True;
77          SignList := TStringList.Create;
78          try
79            with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
80              SignList.Add(ID + U + SS_ONCHART + U + RS_RELEASE + U + NO_WRITTEN);
81            StatusText('Sending Orders to Service(s)...');
82            if SignList.Count > 0 then SendOrders(SignList, '');
83    
84             if (not frmFrame.TimedOut) then
85              begin
86                 if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
87                    frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
88                 else
89                    if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
90                       frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
91              end;
92              uCore.TempEncounterLoc := 0;
93              uCore.TempEncounterLocName := '';
94    
95          //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
96            with SignList do if Count > 0 then for i := 0 to Count - 1 do
97              begin
98                if Pos('E', Piece(SignList[i], U, 2)) > 0 then
99                  begin
100                   OrderText := FindOrderText(Piece(SignList[i], U, 1));
101                   if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
102                   InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
103                           TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
104                   else if Piece(SignList[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
105                   InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
106                           TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
107                   else
108                   InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
109                           TC_SAVERR, MB_OK);
110                 end;
111             end;
112           StatusText('');
113             //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
114           AList := TStringList.Create;
115           try
116             CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
117             if AList.Text <> '' then
118               ReportBox(AList, 'Changed Orders', TRUE);
119           finally
120             AList.Free;
121           end;
122           PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc);
123   //        SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt);  //*KCM*
124   //        if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo);           //*KCM*
125         finally
126           SignList.Free;
127         end;
128       end; {if frmOnChartOrders.OKPressed}
129     finally
130       frmOnChartOrders.Release;
131       with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
132     end;
133   end;
134   
135   procedure TfrmOnChartOrders.FormCreate(Sender: TObject);
136   begin
137     inherited;
138     OKPressed := False;
139   end;
140   
141   procedure TfrmOnChartOrders.cmdOKClick(Sender: TObject);
142   begin
143     inherited;
144     OKPressed := True;
145     Close;
146   end;
147   
148   procedure TfrmOnChartOrders.cmdCancelClick(Sender: TObject);
149   begin
150     inherited;
151     Close;
152   end;
153   
154   procedure TfrmOnChartOrders.lstOrdersMeasureItem(Control: TWinControl;
155     Index: Integer; var AHeight: Integer);
156   var
157     x: string;
158     ARect: TRect;
159   begin
160     inherited;
161     with lstOrders do if Index < Items.Count then
162     begin
163       ARect := ItemRect(Index);
164       Canvas.FillRect(ARect);
165       x := FilteredString(Items[Index]);
166       AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
167       if AHeight <  13 then AHeight := 15;
168     end;
169   end;
170   
171   procedure TfrmOnChartOrders.lstOrdersDrawItem(Control: TWinControl;
172     Index: Integer; Rect: TRect; State: TOwnerDrawState);
173   var
174     x: string;
175     ARect: TRect;
176     SaveColor: TColor;
177   begin
178     inherited;
179     with lstOrders do
180     begin
181       ARect := Rect;
182       ARect.Left := ARect.Left + 2;
183       Canvas.FillRect(ARect);
184       Canvas.Pen.Color := Get508CompliantColor(clSilver);
185       SaveColor := Canvas.Brush.Color;
186       Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
187       Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
188       if Index < Items.Count then
189       begin
190         x := FilteredString(Items[Index]);
191         DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
192         Canvas.Brush.Color := SaveColor;
193         ARect.Right := ARect.Right + 4;
194       end;
195     end;
196   end;
197   
198   procedure TfrmOnChartOrders.Panel2Resize(Sender: TObject);
199   begin
200     inherited;
201     lstOrders.Invalidate;
202   end;
203   
204   end.

Module Calls (2 levels)


fOrdersOnChart
 ├fAutoSz
 │ └fBase508Form
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals
 │ └UBACore
 ├uConst
 ├uOrders
 │ ├uConst
 │ ├rConsults
 │ ├rOrders...
 │ ├fODBase
 │ ├XuDsigS
 │ ├fODDiet
 │ ├fODMisc
 │ ├fODGen
 │ ├fODMedIn
 │ ├fODMedOut
 │ ├fODText
 │ ├fODConsult
 │ ├fODProc
 │ ├fODRad
 │ ├fODLab
 │ ├fODBBank
 │ ├fODMeds
 │ ├fODMedIV
 │ ├fODVitals
 │ ├fODAuto
 │ ├fOMNavA
 │ ├rCore...
 │ ├uCore...
 │ ├fFrame
 │ ├fEncnt
 │ ├fOMVerify
 │ ├fOrderSaveQuick
 │ ├fOMSet
 │ ├rMisc
 │ ├uODBase
 │ ├rODMeds
 │ ├fLkUpLocation
 │ ├fOrdersPrint
 │ ├fOMAction
 │ ├fARTAllgy
 │ ├fOMHTML
 │ ├fOrders
 │ ├rODBase
 │ ├fODChild
 │ ├fMeds
 │ ├rMeds
 │ ├rPCE
 │ ├fRptBox
 │ ├fODMedNVA
 │ ├fODChangeUnreleasedRenew
 │ ├rODAllergy
 │ ├UBAGlobals...
 │ └uTemplateFields
 ├fFrame...
 ├uCore...
 ├fClinicWardMeds
 │ ├fAutoSz...
 │ ├rCore...
 │ └uCore...
 ├rODLab
 │ └uCore...
 └fRptBox...

Module Called-By (2 levels)


         fOrdersOnChart
              fOrders┘ 
            uOrders┤   
            fODBase┤   
             fFrame┤   
              rMisc┤   
            uODBase┤   
              fMeds┤   
          fOrdersDC┤   
          fOrdersCV┤   
            fOMNavA┤   
             fOMSet┤   
 fOrdersEvntRelease┤   
    fODReleaseEvent┤   
         mEvntDelay┤   
          fODActive┤   
        fOrdersCopy┤   
           fMedCopy┤   
fActivateDeactivate┘