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.