Module

fClinicWardMeds

Path

C:\CPRS\CPRS30\fClinicWardMeds.pas

Last Modified

7/15/2014 3:26:36 PM

Units Used in Interface

Name Comments
fAutoSz -
rCore -
uCore -

Units Used in Implementation

Name Comments
fFrame -

Classes

Name Comments
TfrmClinicWardMeds -

Procedures

Name Owner Declaration Scope Comments
btnClinicClick TfrmClinicWardMeds procedure btnClinicClick(Sender: TObject); Public/Published -
btnWardClick TfrmClinicWardMeds procedure btnWardClick(Sender: TObject); Public/Published -
BuildMessage TfrmClinicWardMeds procedure BuildMessage(MsgSw:string); Private -
ClinicOrWardLocation TfrmClinicWardMeds procedure ClinicOrWardLocation(pOrderList:TStringList; pEncounterLoc: integer; pEncounterLocName: string; var RetLoc: integer); overload; Public
Public declarations 
 passes order list and selected locations to rpc to be saved with order.
entry point
rpcChangeOrderLocation TfrmClinicWardMeds procedure rpcChangeOrderLocation(pOrderList:TStringList); Private -
StartLocationCheck TfrmClinicWardMeds procedure StartLocationCheck; Private Private declarations

Functions

Name Owner Declaration Scope Comments
BuildOrderLocList TfrmClinicWardMeds function BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList; Private -
ClinicOrWardLocation TfrmClinicWardMeds function ClinicOrWardLocation(pEncounterLoc: integer):integer;overLoad; Public
Returns Location selected by user.
entry point
rpcIsPatientOnWard TfrmClinicWardMeds function rpcIsPatientOnWard(Patient: string): boolean; Public -
SelectPrintLocation TfrmClinicWardMeds function SelectPrintLocation(pEncounterLoc:integer):integer; Public
Returns button selected by user - ward or clinic.  print location
entry point  -

Global Variables

Name Type Declaration Comments
AClinicLoc Integer ALocation,AWardLoc, AClinicLoc : integer; -
AClinicName UnicodeString AName, ASvc, AWardName, AClinicName: string; -
ALocation Integer ALocation,AWardLoc, AClinicLoc : integer; -
AMsgSw UnicodeString AMsgSw: string; -
AName UnicodeString AName, ASvc, AWardName, AClinicName: string; -
AOrderLocList TStringList AOrderLocList: TStringList; -
ASelectedLoc Integer ASelectedLoc: integer; -
ASvc UnicodeString AName, ASvc, AWardName, AClinicName: string; -
AWardLoc Integer ALocation,AWardLoc, AClinicLoc : integer; -
AWardName UnicodeString AName, ASvc, AWardName, AClinicName: string; -
frmClinicWardMeds TfrmClinicWardMeds frmClinicWardMeds: TfrmClinicWardMeds; -

Constants

Name Declaration Scope Comments
LOC_MSG 'L' Interfaced -
LOC_PRINT_MSG 'P' Interfaced -
LOCATION_CHANGE_1 'This patient is currently admitted to ward' Interfaced -
LOCATION_CHANGE_2 'These orders are written at clinic' Interfaced -
LOCATION_CHANGE_3 'Where do you want the orders administered?' Interfaced -
PRINT_LOCATION_1 'The patient has been admitted to Ward ' Interfaced GE CQ9537 - Message text
PRINT_LOCATION_2 'Should the orders be printed using the new location?' Interfaced -


Module Source

1     unit fClinicWardMeds;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7       Dialogs, fAutoSz, StdCtrls, ExtCtrls, ORCtrls,ORFn, rCore, uCore, oRNet, Math,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmClinicWardMeds = class(TfrmAutoSz)
12        stxtLine3: TStaticText;
13        stxtLine2: TStaticText;
14        stxtLine1: TStaticText;
15        btnClinic: TButton;
16        btnWard: TButton;
17        procedure btnClinicClick(Sender: TObject);
18        procedure btnWardClick(Sender: TObject);
19    
20      private
21        { Private declarations }
22        procedure StartLocationCheck;
23        procedure rpcChangeOrderLocation(pOrderList:TStringList);
24        procedure BuildMessage(MsgSw:string);
25        function  BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList;
26    
27      public
28        { Public declarations }
29        // passes order list and selected locations to rpc to be saved with order.
30        procedure ClinicOrWardLocation(pOrderList:TStringList; pEncounterLoc: integer; pEncounterLocName: string; var RetLoc: integer); overload;
31        // returns Location selected by user.
32        function  ClinicOrWardLocation(pEncounterLoc: integer):integer;overLoad;
33        function  rpcIsPatientOnWard(Patient: string): boolean;
34        function  SelectPrintLocation(pEncounterLoc:integer):integer;
35      end;
36    
37    var
38      frmClinicWardMeds: TfrmClinicWardMeds;
39      ALocation,AWardLoc, AClinicLoc : integer;
40      ASelectedLoc: integer;
41      AName, ASvc, AWardName, AClinicName: string;
42      AOrderLocList: TStringList;
43      AMsgSw: string;
44    
45    const
46      LOCATION_CHANGE_1 = 'This patient is currently admitted to ward';
47      LOCATION_CHANGE_2 = 'These orders are written at clinic';
48      LOCATION_CHANGE_3 = 'Where do you want the orders administered?';
49       //GE CQ9537  - Message text
50      PRINT_LOCATION_1 = 'The patient has been admitted to Ward ';
51      PRINT_LOCATION_2 =  'Should the orders be printed using the new location?';
52      LOC_PRINT_MSG    = 'P';
53      LOC_MSG          = 'L';
54    
55    implementation
56    
57    uses fFrame;
58    
59    {$R *.dfm}
60    
61    //entry point
62    function  TfrmClinicWardMeds.ClinicOrWardLocation(pEncounterLoc:integer):integer;
63    begin
64      // Patient's current location
65       AClinicLoc  := pEncounterLoc;
66       AClinicName := Encounter.LocationName;
67       AMsgSw := LOC_MSG;
68       StartLocationCheck;
69       Result := ASelectedLoc;
70       frmClinicWardMeds.Close;
71    end;
72    
73    //entry point
74    procedure TfrmClinicWardMeds.ClinicOrWardLocation(pOrderList:TStringList;pEncounterLoc:integer;pEncounterLocName:string; var RetLoc: integer);
75    begin
76      AClinicLoc        := pEncounterLoc;
77      AClinicName       := pEncounterLocName;
78      AOrderLocList     := TStringList.create;
79      AOrderLocList.Clear;
80      AMsgSw := LOC_MSG;
81      StartLocationCheck;
82      if pOrderList.Count > 0 then
83         begin
84           rpcChangeOrderLocation(BuildOrderLocList(pOrderList, ASelectedLoc));
85           RetLoc := ASelectedLoc
86         end;
87      if Assigned(AOrderLocList) then FreeAndNil(AOrderLocList);
88      frmClinicWardMeds.Close;
89    end;
90    
91    // returns button selected by user - ward or clinic.  print location
92    //entry point  -
93    function  TfrmClinicWardMeds.SelectPrintLocation(pEncounterLoc:integer):integer;
94    begin
95       AClinicLoc        := pEncounterLoc;
96       AMsgSw            := LOC_PRINT_MSG;
97       StartLocationCheck;
98       Result := ASelectedLoc;
99       frmClinicWardMeds.Close;
100   end;
101   
102   procedure TfrmClinicWardMeds.StartLocationCheck;
103   begin
104   
105     frmClinicWardMeds := TfrmClinicWardMeds.Create(Application);
106    // ResizeFormToFont(TForm(frmClinicWardMeds));
107     CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
108     AWardLoc := ALocation; //current location
109     AWardName := AName; // current location name
110     if AMsgSW = LOC_PRINT_MSG then BuildMessage(AMsgSw)
111     else
112        if (ALocation > 0) and (ALocation <> AClinicLoc) then BuildMessage(AMsgSw); //Location has changed, patient admitted
113   end;
114   
115   procedure TfrmClinicWardMeds.btnClinicClick(Sender: TObject);
116   begin
117     inherited;
118     ASelectedLoc := AClinicLoc;
119     frmClinicWardMeds.Close;
120   end;
121   
122   procedure TfrmClinicWardMeds.btnWardClick(Sender: TObject);
123   begin
124     inherited;
125      ASelectedLoc := AWardLoc;
126      frmClinicWardMeds.Close;
127   end;
128   
129   procedure TfrmClinicWardMeds.BuildMessage(MsgSw:string);
130   var
131    ALine1Len, ALine2Len, ALine3Len, ALongLine: integer;
132   begin
133       with frmClinicWardMeds do
134       begin
135          btnWard.Caption   := 'Ward';
136          btnClinic.Caption := 'Clinic';
137          // message text
138          if MsgSw = LOC_MSG then
139          begin
140             //AClinicName := 'this is my long test clinic Name';
141             stxtLine1.Caption := LOCATION_CHANGE_1 + ' :' + AWardName;
142             stxtLine2.Caption := LOCATION_CHANGE_2+ ' :' + AClinicName;
143             stxtLine3.Caption := LOCATION_CHANGE_3;
144          end
145          else
146             begin
147                 stxtLine1.Caption := PRINT_LOCATION_1 + ':' + AWardName;
148                 stxtLine2.Caption := PRINT_LOCATION_2;
149                 stxtLine3.Caption := '';
150             end;
151       stxtLine2.Left := stxtLine1.left;
152       stxtLine3.Left := stxtLine1.left;
153       ALine1Len := TextWidthByFont(frmClinicWardMeds.stxtLine1.Font.Handle, frmClinicWardMeds.stxtLine1.Caption);
154       ALine2Len := TextWidthByFont(frmClinicWardMeds.stxtLine2.Font.Handle, frmClinicWardMeds.stxtLine2.Caption);
155       ALine3Len := TextWidthByFont(frmClinicWardMeds.stxtLine3.Font.Handle, frmClinicWardMeds.stxtLine3.Caption)+25;
156       ALongLine := Max(ALine1Len,ALine2Len);
157       ALongLine := Max(ALine3Len,ALongLine);
158       frmClinicWardMeds.Width := (ALongLine + frmClinicWardMeds.stxtLine1.Left + 15);
159       end;
160       frmClinicWardMeds.ShowModal;
161       frmClinicWardMeds.Release;
162   
163   end;
164   
165   function  TfrmClinicWardMeds.BuildOrderLocList(pOrderList:TStringList; pLocation:integer):TStringList;
166   var i:integer;
167       AOrderLoc: string;
168   begin
169      AOrderLocList.clear;
170      for i := 0 to pOrderList.Count -1 do
171      begin
172         AOrderLoc := Piece(pOrderList.Strings[i],U,1) + U + IntToStr(pLocation);
173         AOrderLocList.Add(AOrderLoc);
174      end;
175      Result := AOrderLocList; //return value
176   end;
177   
178   procedure TfrmClinicWardMeds.rpcChangeOrderLocation(pOrderList:TStringList);
179   begin
180   // OrderIEN^Location^1  -- used to alter location if ward is selected RPC expected third value to determine if
181   //order is an IMO order. If it is being called from here assumed IMO order.
182   
183      CallV('ORWDX CHANGE',[pOrderList, Patient.DFN, '1']);
184   end;
185   
186   function TfrmClinicWardMeds.rpcIsPatientOnWard(Patient: string): boolean;
187   begin
188     result := sCallV('ORWDX1 PATWARD',[Patient]) = '1';
189   end;
190   
191   
192   end.

Module Calls (2 levels)


fClinicWardMeds
 ├fAutoSz
 │ └fBase508Form
 ├rCore
 │ └uCore
 └uCore...

Module Called-By (2 levels)


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