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 = "Reservations". 00027 00028 def var sprog as char init ?. 00029 def var selection as char init ?. 00030 00031 def buffer b-rate for rate. 00032 def buffer b-room for room. 00033 def buffer b-res2 for reservation. 00034 def buffer b-res for reservation. 00035 def buffer b-out for checkout. 00036 def buffer b-out-room for checkout-room. 00037 def buffer b-out-room2 for checkout-room. 00038 def buffer b-guest for guest. 00039 def buffer b-res-room for reservation-rooms. 00040 00041 def query q-guest for b-guest. 00042 def browse brws-guest query q-guest 00043 display b-guest.guest-id 00044 b-guest.first-name 00045 b-guest.last-name 00046 b-guest.date-of-birth 00047 with 5 down title "Choose Guest". 00048 00049 def var r-checkin like reservation.checkin. 00050 def var r-checkout like reservation.checkout. 00051 def var r-id like reservation.reservation-id. 00052 def var r-discount like reservation.discount. 00053 def var r-state as char format "x(1)" label "State". 00054 def var r-state-name as char format "x(11)". 00055 00056 def var g-id like guest.guest-id. 00057 def var g-f-n like guest.first-name. 00058 def var g-l-n like guest.last-name. 00059 def var g-dob like guest.date-of-birth. 00060 def var g-phone# like guest.phone-number. 00061 def var r-rooms like reservation-rooms.rooms. 00062 def var r-type as char label "Type" format "x(15)". 00063 00064 form r-id 00065 r-checkin 00066 r-checkout 00067 skip 00068 r-state r-state-name no-label r-discount to 49 skip 00069 skip 00070 g-id at row 3 col 20 colon-aligned 00071 g-f-n at row 4 col 20 colon-aligned 00072 g-l-n at row 5 col 20 colon-aligned 00073 g-dob at row 6 col 20 colon-aligned 00074 g-phone# at row 7 col 20 colon-aligned 00075 with frame f-res size 80 by 20 at row 2 col 1 title "Reservation Management" side-labels. 00076 00077 form r-type r-rooms with 00078 frame f-res-rooms title "Reserved Rooms" 00079 10 down. 00080 00081 frame f-res-rooms:frame = frame f-res:handle. 00082 frame f-res-rooms:col = 40. 00083 frame f-res-rooms:row = 5. 00084 00085 form brws-guest with frame f-guests no-box overlay centered size 80 by 9. 00086 00087 def query q-res for reservation scrolling. 00088 open query q-res for each reservation 00089 where /* reservation.checkin >= today and */ reservation.state <> 'C' no-lock use-index idx-r-checkin. 00090 00091 def var guest-names as char extent 4. 00092 form b-out-room.guest-ids[1] label "Guest 1" help "Enter ? to search" guest-names[1] format "x(30)" no-label skip 00093 b-out-room.guest-ids[2] label "Guest 2" help "Enter ? to search" guest-names[2] format "x(30)" no-label skip 00094 b-out-room.guest-ids[3] label "Guest 3" help "Enter ? to search" guest-names[3] format "x(30)" no-label skip 00095 b-out-room.guest-ids[4] label "Guest 4" help "Enter ? to search" guest-names[4] format "x(30)" no-label skip 00096 with side-labels frame f-room-guests centered overlay size 60 by 6. 00097 00098 procedure refresh. 00099 find reservation where reservation.reservation-id = r-id no-lock no-error. 00100 00101 if not avail(reservation) then do: 00102 clear frame f-res all. 00103 return. 00104 end. 00105 00106 find b-res where recid(b-res) = recid(reservation) no-lock no-error. 00107 00108 r-id = b-res.reservation-id. 00109 r-checkin = b-res.checkin. 00110 r-checkout = b-res.checkout. 00111 r-discount = b-res.discount. 00112 r-state = b-res.state. 00113 g-id = b-res.guest-id. 00114 00115 find b-guest where b-guest.guest-id = g-id no-lock no-error. 00116 if avail(b-guest) then do: 00117 g-f-n = b-guest.first-name. 00118 g-l-n = b-guest.last-name. 00119 g-dob = b-guest.date-of-birth. 00120 g-phone# = b-guest.phone-number. 00121 end. 00122 else do: 00123 g-f-n = "". 00124 g-l-n = "". 00125 g-dob = ?. 00126 g-phone# = "". 00127 end. 00128 00129 case r-state: 00130 when "P" then r-state-name = "Placed". 00131 when "C" then r-state-name = "Canceled". 00132 when "I" then r-state-name = "CheckedIn". 00133 when "O" then r-state-name = "CheckedOut". 00134 otherwise r-state-name = "n/a". 00135 end. 00136 00137 display r-id 00138 r-checkin 00139 r-checkout 00140 r-discount 00141 r-state 00142 r-state-name 00143 g-id 00144 g-f-n 00145 g-l-n 00146 g-dob 00147 g-phone# 00148 with frame f-res. 00149 00150 clear frame f-res-rooms all. 00151 for each b-res-room where b-res-room.reservation-id = r-id: 00152 r-type = room-types[b-res-room.type-of-room]. 00153 r-rooms = b-res-room.rooms. 00154 00155 display r-type r-rooms with frame f-res-rooms. 00156 down 1 with frame f-res-rooms. 00157 end. 00158 end. 00159 00160 procedure choose-guest. 00161 def output param g-id as int init ?. 00162 00163 G-SEARCH: 00164 repeat on endkey undo, leave: 00165 def button btn-ok label "Find". 00166 def button btn-cancel label "Cancel". 00167 00168 form g-f-n skip 00169 g-l-n skip 00170 g-dob skip 00171 btn-ok 00172 btn-cancel 00173 with frame f-search side-labels overlay at row 2 col 1 title "Find Guest" 00174 cancel-button btn-cancel default-button btn-ok. 00175 00176 update g-f-n g-l-n g-dob with frame f-search. 00177 00178 if g-f-n = "" and g-l-n = "" and g-dob = ? 00179 then do: 00180 message "Enter at least one search criteri!". 00181 next g-search. 00182 end. 00183 00184 def var t-f-guests as int. 00185 t-f-guests = 0. 00186 g-id = ?. 00187 00188 for each b-guest 00189 where (if g-f-n = ? or g-f-n = "" then true else b-guest.first-name matches g-f-n + "*") and 00190 (if g-l-n = ? or g-l-n = "" then true else b-guest.last-name matches g-l-n + "*") and 00191 (if g-dob = ? then true else b-guest.date-of-birth = g-dob) no-lock: 00192 00193 t-f-guests = t-f-guests + 1. 00194 00195 if t-f-guests = 1 00196 then g-id = b-guest.guest-id. 00197 else if t-f-guests >= 2 then leave. 00198 end. 00199 00200 if t-f-guests > 0 then do: 00201 00202 if t-f-guests = 1 then do: 00203 leave g-search. 00204 end. 00205 00206 open query q-guest for each b-guest 00207 where (if g-f-n = ? or g-f-n = "" then true else b-guest.first-name matches g-f-n + "*") and 00208 (if g-l-n = ? or g-l-n = "" then true else b-guest.last-name matches g-l-n + "*") and 00209 (if g-dob = ? then true else b-guest.date-of-birth = g-dob). 00210 00211 update brws-guest with frame f-guests. 00212 hide frame f-guests no-pause. 00213 00214 g-id = b-guest.guest-id. 00215 00216 leave g-search. 00217 end. 00218 else do: 00219 message "Guest not found! Add new guest?" view-as alert-box buttons yes-no update g-add as logical. 00220 00221 if g-add then do: 00222 do transaction on error undo, leave 00223 on endkey undo, leave: 00224 find last b-guest use-index idx-g-id no-lock no-error. 00225 g-id = (if avail b-guest then b-guest.guest-id + 1 else 1). 00226 release b-guest. 00227 00228 create b-guest. 00229 assign b-guest.guest-id = g-id. 00230 00231 form b-guest.guest-id at row 1 col 20 colon-aligned 00232 b-guest.first-name at row 2 col 20 colon-aligned 00233 b-guest.last-name at row 3 col 20 colon-aligned 00234 b-guest.date-of-birth at row 4 col 20 colon-aligned 00235 with frame f-add-guest overlay centered title "Add guest" side-labels. 00236 00237 display b-guest.guest-id with frame f-add-guest. 00238 00239 update b-guest.first-name 00240 b-guest.last-name 00241 b-guest.date-of-birth 00242 with frame f-add-guest. 00243 hide frame f-add-guest no-pause. 00244 release b-guest. 00245 end. 00246 00247 leave G-SEARCH. 00248 end. 00249 end. 00250 end. 00251 00252 hide frame f-search no-pause. 00253 end. 00254 00255 00256 on "leave" of b-out-room.guest-ids[1] in frame f-room-guests or 00257 "leave" of b-out-room.guest-ids[2] in frame f-room-guests or 00258 "leave" of b-out-room.guest-ids[3] in frame f-room-guests or 00259 "leave" of b-out-room.guest-ids[4] in frame f-room-guests 00260 do: 00261 def var g-id as int. 00262 00263 if focus:screen-value = "?" then do: 00264 run choose-guest(output g-id). 00265 00266 if g-id = ? then return no-apply. 00267 00268 focus:screen-value = string(g-id). 00269 end. 00270 else g-id = int(focus:screen-value). 00271 00272 if g-id <> 0 then do: 00273 find b-guest where b-guest.guest-id = g-id no-lock. 00274 focus:next-sibling:screen-value = b-guest.first-name + " " + b-guest.last-name. 00275 end. 00276 end. 00277 00278 on "return" of g-id in frame f-res do: 00279 if g-id:screen-value = "?" then do: 00280 00281 run choose-guest(output g-id). 00282 00283 display g-id with frame f-res. 00284 00285 g-f-n = "". 00286 g-l-n = "". 00287 g-dob = ?. 00288 00289 return no-apply. 00290 end. 00291 end. 00292 00293 get first q-res. 00294 if avail reservation then r-id = reservation.reservation-id. 00295 run refresh. 00296 00297 PROC: 00298 repeat: 00299 if u-name = ? or u-name = "" then do: 00300 message "You are not logged in - access denied" view-as alert-box. 00301 quit. 00302 end. 00303 00304 h-time = string(now, "99/99/99 HH:MM:SS"). 00305 h-time = substring(h-time, 10). 00306 00307 do with frame f-main-header: 00308 u-name:column = 1. 00309 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. 00310 h-time:column = frame f-main-header:width-chars - length(h-time). 00311 screen-title:format = "x(" + string(length(screen-title)) + ")". 00312 end. 00313 00314 display u-name screen-title h-time with frame f-main-header. 00315 00316 00317 sprog = ?. 00318 case selection: 00319 when "P" then do: 00320 get prev q-res. 00321 if not avail reservation then do: 00322 get first q-res. 00323 end. 00324 00325 if avail reservation then do: 00326 r-id = reservation.reservation-id. 00327 run refresh. 00328 end. 00329 end. 00330 when "N" then do: 00331 get next q-res. 00332 if not avail reservation then do: 00333 get last q-res. 00334 end. 00335 00336 if avail reservation then do: 00337 r-id = reservation.reservation-id. 00338 run refresh. 00339 end. 00340 end. 00341 when "F" then do: 00342 get first q-res. 00343 00344 if avail reservation then do: 00345 r-id = reservation.reservation-id. 00346 run refresh. 00347 end. 00348 end. 00349 when "L" then do: 00350 get last q-res. 00351 00352 if avail reservation then do: 00353 r-id = reservation.reservation-id. 00354 run refresh. 00355 end. 00356 end. 00357 00358 when "I" then do: 00359 /* find by name, date of birth */ 00360 def button btn-ok label "Find". 00361 def button btn-cancel label "Cancel". 00362 00363 form g-f-n skip 00364 g-l-n skip 00365 g-dob skip 00366 btn-ok 00367 btn-cancel 00368 with frame f-res-search side-labels overlay at row 2 col 1 title "Find Reservation" 00369 cancel-button btn-cancel default-button btn-ok. 00370 00371 on "choose" of btn-cancel in frame f-res-search do: 00372 apply "f4" to frame f-res-search. 00373 end. 00374 on "choose" of btn-ok in frame f-res-search do: 00375 apply "go" to frame f-res-search. 00376 end. 00377 00378 G-SEARCH: 00379 repeat on endkey undo, leave: 00380 g-f-n = "". 00381 g-l-n = "". 00382 g-dob = ?. 00383 update g-f-n g-l-n g-dob btn-ok btn-cancel with frame f-res-search. 00384 00385 if g-f-n = "" and g-l-n = "" and g-dob = ? 00386 then do: 00387 message "Enter at least one search criteria!". 00388 next g-search. 00389 end. 00390 00391 for each b-guest 00392 where (if g-f-n = ? or g-f-n = "" then true else b-guest.first-name matches g-f-n + "*") and 00393 (if g-l-n = ? or g-l-n = "" then true else b-guest.last-name matches g-l-n + "*") and 00394 (if g-dob = ? then true else b-guest.date-of-birth = g-dob) no-lock, 00395 first b-res where b-res.guest-id = b-guest.guest-id and b-res.checkout >= today use-index idx-r-checkin: 00396 00397 r-id = b-res.reservation-id. 00398 leave. 00399 end. 00400 00401 leave. 00402 end. 00403 00404 hide frame f-res-search no-pause. 00405 find reservation where reservation.reservation-id = r-id no-lock no-error. 00406 if avail reservation then do: 00407 reposition q-res to rowid rowid(reservation). 00408 get next q-res. 00409 run refresh. 00410 end. 00411 end. 00412 when "A" then do: 00413 r-id = (if avail reservation then reservation.reservation-id else ?). 00414 00415 ADD-RES: 00416 repeat transaction on error undo, leave 00417 on endkey undo, leave: 00418 /* 00419 step 1: create new reservation id 00420 step 2: enter checkin/checkout dates 00421 step 3: enter discount/set state 00422 step 4: set new guest ID - enter "?" to choose/search guest, where a new guest can be added 00423 step 5: enter how many rooms and for each count, the room type 00424 -> check if the room is available.... 00425 */ 00426 CREATE-RES: 00427 repeat on error undo, next: 00428 find last b-res use-index idx-r-id no-lock no-error. 00429 r-id = (if avail b-res then b-res.reservation-id + 1 else 1). 00430 release b-res. 00431 00432 create b-res. 00433 assign b-res.reservation-id = r-id. 00434 leave CREATE-RES. 00435 end. 00436 00437 clear frame f-res all. 00438 clear frame f-res-rooms all. 00439 display r-id 00440 with frame f-res. 00441 00442 def var r-del as log. 00443 r-del = yes. 00444 00445 r-checkin = ?. 00446 r-checkout = ?. 00447 00448 UPDATE-RES: 00449 repeat on endkey undo ADD-RES, leave ADD-RES 00450 on error undo ADD-RES, leave ADD-RES: 00451 update r-checkin 00452 validate (r-checkin >= today, "Checkin must be greater or equal than " + string(today)) 00453 with frame f-res. 00454 00455 update r-checkout 00456 validate (r-checkout > r-checkin, "Checkout must be greater than" + string(r-checkin)) 00457 with frame f-res. 00458 00459 b-res.checkin = r-checkin. 00460 b-res.checkout = r-checkout. 00461 00462 repeat on endkey undo, next UPDATE-RES 00463 on error undo, next UPDATE-RES: 00464 update r-discount with frame f-res. 00465 b-res.discount = r-discount. 00466 leave. 00467 end. 00468 00469 b-res.state = res-state-ch[res-state-placed]. 00470 display res-state-ch[res-state-placed] @ r-state with frame f-res. 00471 00472 SEL-GUEST: 00473 repeat on endkey undo UPDATE-RES, next UPDATE-RES: 00474 g-f-n = "". 00475 g-l-n = "". 00476 g-dob = ?. 00477 00478 g-id = ?. 00479 update g-id help "Enter ? to search guest or guest-id" 00480 with frame f-res. 00481 00482 find b-guest where b-guest.guest-id = g-id no-lock no-error. 00483 if avail b-guest then do: 00484 g-f-n = b-guest.first-name. 00485 g-l-n = b-guest.last-name. 00486 g-dob = b-guest.date-of-birth. 00487 g-phone# = b-guest.phone-number. 00488 00489 display g-f-n g-l-n g-dob g-phone# with frame f-res. 00490 00491 b-res.guest-id = g-id. 00492 00493 leave SEL-GUEST. 00494 end. 00495 else do: 00496 message "Guest not found!" view-as alert-box. 00497 end. 00498 end. 00499 00500 def var r-r-type like room.type-of-room. 00501 00502 form 00503 r-r-type format ">>>,>>>,>>>" view-as combo-box inner-lines 5 label "Room type" 00504 skip 00505 r-rooms label "No. of Rooms" 00506 validate (r-rooms > 0, "Must set no. of rooms!") 00507 with frame f-res-room side-labels. 00508 run set-room-types-combo (input r-r-type:handle in frame f-res-room). 00509 00510 repeat on endkey undo UPDATE-RES, next UPDATE-RES: 00511 r-r-type = 1. 00512 update r-r-type r-rooms with frame f-res-room overlay centered title "Book Room". 00513 00514 def var res-rooms as int. 00515 def var total-rooms as int. 00516 res-rooms = 0. 00517 total-rooms = 0. 00518 00519 for each room where room.type-of-room = r-r-type no-lock: 00520 total-rooms = total-rooms + 1. 00521 end. 00522 00523 for each b-res2 00524 where b-res2.checkin >= r-checkin and b-res2.checkout <= r-checkin and 00525 b-res2.state <> res-state-ch[res-state-canceled] no-lock: 00526 res-rooms = res-rooms + 1. 00527 end. 00528 00529 if total-rooms - res-rooms <= 0 then do: 00530 message "No available [" + room-types[r-r-type] + "] rooms for " + string(r-checkin) " - " + string(r-checkout) + "!" view-as alert-box. 00531 undo, retry. 00532 end. 00533 00534 create b-res-room. 00535 b-res-room.reservation-id = r-id. 00536 b-res-room.rooms = r-rooms. 00537 b-res-room.type-of-room = r-r-type. 00538 00539 release b-res-room. 00540 run refresh. 00541 00542 message "Add another?" view-as alert-box buttons yes-no update l-r-add as logical. 00543 if not l-r-add then leave. 00544 end. 00545 00546 r-del = false. 00547 leave. 00548 end. 00549 00550 if r-del then undo ADD-RES, leave ADD-RES. 00551 else leave ADD-RES. 00552 end. 00553 00554 find reservation where reservation.reservation-id = r-id no-lock no-error. 00555 run refresh. 00556 end. 00557 when "K" then do: 00558 00559 /* 00560 checkin, create the records with: 00561 - reservation: set the state to "checked in" 00562 - checkout: 00563 - checkout-rooms: 00564 set the room numbers for each room 00565 set the guest-id's for each room (one or more) 00566 */ 00567 00568 if reservation.state <> "P" then do: 00569 message "Reservation must be in (P)laced state" view-as alert-box. 00570 end. 00571 else 00572 R-CHECKIN: 00573 do transaction on error undo, leave 00574 on endkey undo, leave: 00575 find b-res where b-res.reservation-id = r-id exclusive-lock. 00576 00577 b-res.state = "I". 00578 00579 create b-out. 00580 b-out.reservation-id = b-res.reservation-id. 00581 b-out.state = "I". 00582 b-out.room-charges = 0. 00583 b-out.sales-tax = 0. 00584 b-out.total = 0. 00585 00586 for each b-res-room where b-res-room.reservation-id = b-res.reservation-id: 00587 00588 def var ridx as int. 00589 00590 do ridx = 1 to b-res-room.rooms on error undo R-CHECKIN, leave R-CHECKIN 00591 on endkey undo R-CHECKIN, leave R-CHECKIN: 00592 create b-out-room. 00593 b-out-room.reservation-id = b-res.reservation-id. 00594 b-out-room.room-charges = 0. 00595 b-out-room.laundry-charges = 0. 00596 b-out-room.minibar-charges = 0. 00597 00598 def var r-num as int. 00599 00600 /* search for an available room */ 00601 open query q-rs-room 00602 for each b-room where b-room.type-of-room = b-res-room.type-of-room. 00603 get first q-rs-room. 00604 00605 def var r-ok as log. 00606 00607 R-B-ROOM: 00608 do while avail b-room: 00609 message "checking " b-room.room-number. 00610 00611 r-ok = yes. 00612 00613 for each b-res2 where b-res2.checkin >= b-res.checkin and b-res2.checkin <= b-res.checkout no-lock, 00614 each b-out-room2 00615 where recid(b-out-room2) <> recid(b-out-room) and 00616 b-out-room2.room-number = b-room.room-number and 00617 b-out-room2.reservation-id = b-res2.reservation-id 00618 no-lock: 00619 00620 r-ok = no. 00621 leave. 00622 end. 00623 00624 if r-ok then do: 00625 leave R-B-ROOM. 00626 end. 00627 else do: 00628 get next q-rs-room. 00629 end. 00630 end. 00631 00632 if not avail b-room then do: 00633 message "Can't find available room for [" + room-types[b-res-room.type-of-room] + "] in selected period!" view-as alert-box. 00634 undo R-CHECKIN, leave R-CHECKIN. 00635 end. 00636 00637 R-RATE: 00638 repeat: 00639 b-out-room.room-number = b-room.room-number. 00640 find last b-rate 00641 where b-rate.type-of-room = b-room.type-of-room and 00642 b-rate.start-date <= today and (b-rate.end-date = ? or b-rate.end-date >= today) 00643 use-index idx-rate-e-date no-lock no-error. 00644 00645 if not avail b-rate then do: 00646 find last b-rate 00647 where b-rate.type-of-room = b-room.type-of-room and 00648 b-rate.end-date <= today 00649 use-index idx-rate-e-date no-lock no-error. 00650 end. 00651 00652 if not avail b-rate then do: 00653 message "Can't find rate for room [" + room-types[b-room.type-of-room] + "] in booked period!". 00654 leave R-RATE. 00655 end. 00656 else do: 00657 b-out-room.room-charges = b-rate.rate * (b-res.checkout - b-res.checkin). 00658 leave. 00659 end. 00660 end. 00661 00662 def var gidx as int. 00663 b-out.room-charges = b-out.room-charges + b-out-room.room-charges. 00664 b-out-room.guest-ids = 0. 00665 b-out-room.guest-ids[1] = ?. 00666 00667 clear frame f-room-guests. 00668 frame f-room-guests:title = "Checkin room " + string(b-room.room-number) + " [" + room-types[b-room.type-of-room] + "]". 00669 update b-out-room.guest-ids with frame f-room-guests. 00670 end. 00671 end. 00672 end. 00673 00674 find reservation where reservation.reservation-id = r-id no-lock. 00675 run refresh. 00676 end. 00677 when "C" then do: 00678 /* cancel the reservation */ 00679 if reservation.state = "P" 00680 then do transaction on error undo, leave 00681 on endkey undo, leave: 00682 message "Cancel current reservation?" update l-res-cancel as log view-as alert-box buttons yes-no-cancel. 00683 if l-res-cancel then do: 00684 find b-res where b-res.reservation-id = r-id exclusive-lock. 00685 b-res.state = "C". 00686 release b-res. 00687 run refresh. 00688 end. 00689 end. 00690 else do: 00691 message "Only processed reservations can be canceled". 00692 pause. 00693 end. 00694 end. 00695 when "D" then do: 00696 message "Delete current reservation?" update l-res-del as log view-as alert-box buttons yes-no-cancel. 00697 00698 if l-res-del then do transaction: 00699 find b-res where b-res.reservation-id = r-id exclusive-lock. 00700 for each b-res-room where b-res-room.reservation-id = b-res.reservation-id exclusive-lock: 00701 delete b-res-room. 00702 end. 00703 00704 delete b-res. 00705 00706 selection = "P". 00707 next PROC. 00708 end. 00709 end. 00710 00711 when "R" then do: 00712 publish "pop-program". 00713 leave PROC. 00714 end. 00715 otherwise do: 00716 if selection <> ? then do: 00717 message "Invalid selection - try again". 00718 selection = ?. 00719 pause. 00720 next. 00721 end. 00722 end. 00723 end. 00724 00725 if sprog <> ? then leave PROC. 00726 00727 selection = "R". /* assume we are returning; otherwise the user entered something valid */ 00728 00729 CHOICE: 00730 repeat on endkey undo CHOICE, leave CHOICE: 00731 hide message no-pause. 00732 message "(P)rev (N)ext (F)irst (L)ast". 00733 message "F(i)nd (A)dd (D)elete Chec(k) in (C)ancel (R)eturn" update selection format "x(1)" auto-return. 00734 00735 selection = caps(selection). 00736 leave. 00737 end. 00738 00739 end. 00740 00741 if sprog <> ? then do: 00742 publish "push-program" (sprog). 00743 end.