00001 def new global shared var prog-started as log. 00002 def new global shared var u-name as char. 00003 00004 def shared var screen-title as char. 00005 00006 def shared var total-floor-no as int init 4. 00007 def shared var room-types as char extent 5. 00008 00009 def shared var res-state as char extent 4. 00010 def shared var res-state-ch as char extent 4. 00011 00012 def shared var res-state-placed as int init 1. 00013 def shared var res-state-canceled as int init 2. 00014 def shared var res-state-checked-in as int init 3. 00015 def shared var res-state-checked-out as int init 4. 00016 00017 prog-started = true. 00018 def var h-time as char. 00019 00020 form u-name view-as text 00021 screen-title view-as text 00022 h-time view-as text 00023 with frame f-main-header size 80 by 1 no-box no-underline no-labels at row 1 col 1. 00024 00025 00026 screen-title = "Room Management". 00027 00028 def buffer b-room2 for room. 00029 def buffer b-room-state2 for room-state. 00030 00031 def new shared var current-floor-no as int init 1. 00032 def var selection as char init ?. 00033 def var sprog as char init ?. 00034 00035 def var is-ok as log. 00036 def var c-room as recid. 00037 00038 find first room where room.floor = current-floor-no no-lock use-index idx-r-no no-error. 00039 c-room = (if avail(room) then recid(room) else ?). 00040 00041 def var r-floor like room.floor. 00042 def var r-no like room.room-number. 00043 def var r-type like room.type-of-room. 00044 def var r-state like room-state.state init yes. 00045 def var r-state-date like room-state.start-date. 00046 00047 form r-floor 00048 skip 00049 r-no 00050 skip 00051 r-type format ">>>,>>>,>>>" view-as combo-box inner-lines 5 label "Room type" 00052 skip 00053 r-state-date 00054 skip 00055 r-state 00056 with frame f-room side-labels size 80 by 20 at row 2 col 1. 00057 00058 run set-room-types-combo (input r-type:handle in frame f-room). 00059 00060 view frame f-room. 00061 00062 procedure refresh. 00063 def buffer b-room for room. 00064 if c-room = ? then do: 00065 clear frame f-room all no-pause. 00066 return. 00067 end. 00068 00069 find b-room where recid(b-room) = c-room no-lock. 00070 r-floor = b-room.floor. 00071 r-no = b-room.room-number. 00072 r-type = b-room.type-of-room. 00073 00074 /* find room state*/ 00075 find last room-state where room-state.room-number = b-room.room-number and room-state.start-date <= today no-lock no-error. 00076 if avail room-state then do: 00077 r-state-date = room-state.start-date. 00078 r-state = room-state.state. 00079 end. 00080 else do: 00081 r-state-date = today. 00082 r-state = yes. 00083 end. 00084 00085 display r-floor r-no r-type r-state r-state-date with frame f-room. 00086 end. 00087 00088 run refresh. 00089 00090 PROC: 00091 repeat: 00092 if u-name = ? or u-name = "" then do: 00093 message "You are not logged in - access denied" view-as alert-box. 00094 quit. 00095 end. 00096 00097 h-time = string(now, "99/99/99 HH:MM:SS"). 00098 h-time = substring(h-time, 10). 00099 00100 do with frame f-main-header: 00101 u-name:column = 1. 00102 screen-title:column = u-name:column + length(u-name) + (frame f-main-header:width-chars - length(u-name) - length(screen-title) - length(h-time)) / 2. 00103 h-time:column = frame f-main-header:width-chars - length(h-time). 00104 screen-title:format = "x(" + string(length(screen-title)) + ")". 00105 end. 00106 00107 display u-name screen-title h-time with frame f-main-header. 00108 00109 00110 sprog = ?. 00111 case selection: 00112 when "P" then do: 00113 find prev room where room.floor = current-floor-no no-lock use-index idx-r-no no-error. 00114 if avail room then do: 00115 c-room = recid(room). 00116 run refresh. 00117 end. 00118 end. 00119 when "N" then do: 00120 find next room where room.floor = current-floor-no no-lock use-index idx-r-no no-error. 00121 if avail room then do: 00122 c-room = recid(room). 00123 run refresh. 00124 end. 00125 end. 00126 when "F" then do: 00127 find first room where room.floor = current-floor-no no-lock use-index idx-r-no no-error. 00128 if avail room then do: 00129 c-room = recid(room). 00130 run refresh. 00131 end. 00132 end. 00133 when "L" then do: 00134 find last room where room.floor = current-floor-no no-lock use-index idx-r-no no-error. 00135 if avail room then do: 00136 c-room = recid(room). 00137 run refresh. 00138 end. 00139 end. 00140 when "I" then do: 00141 def var r-no2 as int. 00142 do on endkey undo, leave: 00143 update r-no2 label "Room number" validate(can-find(first room where room.room-number = r-no2), "Room number doesn't exist!") 00144 with frame f-find overlay centered side-labels title "Find Room by Number". 00145 end. 00146 hide frame f-find no-pause. 00147 00148 find room where room.room-number = r-no2 no-lock no-error. 00149 if avail room then do: 00150 c-room = recid(room). 00151 current-floor-no = room.floor. 00152 run refresh. 00153 end. 00154 end. 00155 when "D" then do: 00156 if c-room <> ? then do: 00157 find b-room2 where recid(b-room2) = c-room. 00158 00159 find b-room-state2 where b-room-state2.room = b-room2.room-number no-lock no-error. 00160 if avail b-room-state2 and not b-room-state2.state 00161 then do: 00162 message "The room is already inactive" view-as alert-box. 00163 end. 00164 else do: 00165 message "Deactivate room starting with" today "?" update is-ok view-as alert-box buttons yes-no. 00166 if is-ok then do: 00167 if avail b-room-state2 and b-room-state2.start-date = today 00168 then do transaction: 00169 find current b-room-state2 exclusive-lock. 00170 b-room-state2.state = no. 00171 end. 00172 else do transaction: 00173 create b-room-state2. 00174 b-room-state2.room-number = b-room2.room-number. 00175 b-room-state2.state = no. 00176 b-room-state2.start-date = today. 00177 end. 00178 end. 00179 end. 00180 end. 00181 run refresh. 00182 end. 00183 when "A" then do: 00184 release b-room2. 00185 if c-room <> ? then do: 00186 find b-room2 where recid(b-room2) = c-room. 00187 00188 find b-room-state2 where b-room-state2.room = b-room2.room-number no-lock no-error. 00189 if avail b-room-state2 and b-room-state2.state 00190 then do: 00191 message "The room is already active" view-as alert-box. 00192 end. 00193 else do: 00194 message "Activate room starting with" today "?" update is-ok view-as alert-box buttons yes-no. 00195 if is-ok then do: 00196 if avail b-room-state2 and b-room-state2.start-date = today 00197 then do transaction: 00198 find current b-room-state2 exclusive-lock. 00199 b-room-state2.state = yes. 00200 end. 00201 else do transaction: 00202 create b-room-state2. 00203 b-room-state2.room-number = b-room2.room-number. 00204 b-room-state2.state = yes. 00205 b-room-state2.start-date = today. 00206 end. 00207 end. 00208 end. 00209 end. 00210 run refresh. 00211 end. 00212 when "S" then do: 00213 do on endkey undo, leave: 00214 def var floor-no as int. 00215 floor-no = current-floor-no. 00216 update floor-no label "Floor number" validate(floor-no >= 1 and floor-no <= total-floor-no, "Floor number must be between 1 and " + string(total-floor-no)) 00217 with frame f-floor-no overlay centered side-labels title "Set Floor Number". 00218 hide frame f-floor-no no-pause. 00219 current-floor-no = floor-no. 00220 end. 00221 find first room where room.floor = current-floor-no no-lock use-index idx-r-no no-error. 00222 if not avail room then do: 00223 c-room = ?. 00224 message "No more rooms". 00225 end. 00226 else do: 00227 c-room = recid(room). 00228 end. 00229 run refresh. 00230 end. 00231 when "O" then sprog = "rooms-overview.p". 00232 when "M" then do: 00233 run rooms-add.p. 00234 find first room where room.floor = current-floor-no no-lock use-index idx-r-no no-error. 00235 if avail room then do: 00236 c-room = recid(room). 00237 run refresh. 00238 end. 00239 end. 00240 when "R" then do: 00241 publish "pop-program". 00242 leave PROC. 00243 end. 00244 when "U" then do: 00245 if c-room <> ? then do transaction: 00246 update r-type with frame f-room. 00247 find b-room2 where recid(b-room2) = c-room exclusive-lock. 00248 b-room2.type-of-room = r-type. 00249 end. 00250 end. 00251 otherwise do: 00252 if selection <> ? then do: 00253 message "Invalid selection - try again". 00254 selection = ?. 00255 pause. 00256 next. 00257 end. 00258 end. 00259 end. 00260 00261 if sprog <> ? then leave PROC. 00262 00263 selection = "R". /* assume we are returning; otherwise the user entered something valid */ 00264 00265 CHOICE: 00266 repeat on endkey undo CHOICE, leave CHOICE: 00267 hide message no-pause. 00268 message "(P)rev (N)ext (F)irst (L)ast (D)eactivate (A)ctivate". 00269 message "(S)et Floor No F(i)nd (O)verview Add Roo(m)s (U)pdate (R)eturn" update selection format "x(1)" auto-return. 00270 00271 selection = caps(selection). 00272 leave. 00273 end. 00274 00275 end. 00276 00277 if sprog <> ? then do: 00278 publish "push-program" (sprog). 00279 end.