home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / chrchpr2.zip / CSELODGE.CMD < prev    next >
OS/2 REXX Batch file  |  1987-01-06  |  8KB  |  294 lines

  1. * Program CSELODGE - Tracks lodging assignments
  2. Select secondary
  3. Store 'ROOM=' to infield
  4. If len(MSEL) > 1
  5.   Store msel+'  ' to msel
  6.   Store $(msel,2,3) to inlodg
  7.   Store infield+inlodg to sfield
  8.   Find &sfield
  9.   If #=0
  10.     Accept 'Lodging code not found. Press <return> ' to xx
  11.     RETURN
  12.   endif
  13. else
  14.  ? '       ',ename,'   LODGING names             '+curdate
  15.  Find &INFIELD
  16.  If #=0
  17. Accept 'No Lodgings found. You must enter some from SET UP. Press <retn>' to XX
  18.   RETURN
  19.  endif
  20.  Store ' ' to romvalid
  21.  Set raw on
  22.  Do while spact=infield
  23.   Store romvalid+$(spact,5,4) to romvalid
  24.   Store $(spact,1,9) to innf
  25.   ? '[',$(spact,6,3),']  ',$(spact,9,30)
  26.   Do while spact=innf.or.$(spact,9,1)='.'
  27.     SKIP
  28.   enddo
  29.  enddo
  30.  Store 'Y' to xsel
  31.  ?
  32.  ? 'VALID LODGING CODES: ',romvalid
  33.  Set raw off
  34.  ?
  35.  Accept '         Select a Lodging code (3 characters) ' to inlodg
  36.  Store F to goodlodg
  37.  Do while .not. goodlodg
  38.   Store $(inlodg,1,3) to inlodg
  39.   Store '='+inlodg to innlodge
  40.   Store T to goodlodg
  41.   If !(inlodg)='Q' .and. len(inlodg)=1
  42.     Store T to goodlodg
  43.     Store 'Q  ' to inlodg
  44.   else
  45.    If @(innlodge,romvalid)=0
  46.     Accept 'Lodging code is not found. Enter another ' to inlodg
  47.     Store F to goodlodg
  48.    else
  49.     Store 'ROOM'+innlodge to sfield
  50.     Find &sfield
  51.     If #=0
  52.       Accept 'Lodging code is not found.  Enter another' to inlodg
  53.       Store 'n' to xsel
  54.       Store F to goodlodg
  55.     endif
  56.    endif
  57.   endif
  58. enddo
  59. endif
  60. If inlodg<>'Q  '
  61. Store '['+$(spact,6,3)+'] '+trim($(spact,9,30)) to romname
  62. Store $(spact,1,9) to sfield
  63. Release inlodg,romvalid,goodlodg,innlodge,innf
  64. Store ' ' to xsel
  65. Store str(#,5) to xrec
  66. Do while !(xsel)<>'Q'
  67. Select secondary
  68. GOTO &xrec
  69. SKIP
  70. Erase
  71. @ 1,0 say ROMNAME+'    '+ename
  72. @ 1,64 say curdate
  73. Store 3 to I
  74. Store 3 to J
  75. Do while spact=sfield .and. .not. EOF
  76.   Store 3 to I
  77.   Store 3 to J
  78.   Do while J<80 .and. spact=sfield .and. .not. EOF
  79.     @ I,J say $(spact,9,30)
  80.     SKIP
  81.     store I+1 to I
  82.     If I=23
  83.       Store J+40 to J
  84.       Store 3 to I
  85.     endif
  86.   enddo
  87.  enddo
  88.  Store ' ' to xsel
  89.  Store I-3 to II
  90.  If J=43
  91.    Store II+20 to II
  92.  endif
  93.  Do while !(xsel)<>'Q'.and.!(xsel)<>'S'
  94.    @ 22,78 say ' '
  95.    Accept ;
  96.    'Select:  A]dd   C]hange   D]elete   R]eport   S]creen   V]erify   Q]uit ' ;
  97.    to xsel
  98.    Do CASE
  99.    CASE !(xsel)='V'
  100.      Select secondary
  101.      GOTO &xrec
  102.      SKIP
  103.      If spact<>sfield
  104.        Accept "No names are assigned to this Lodging.  Press <retn>" to xx
  105.      else
  106. ? 'Now verifying EDIRFILE names against Lodging assignments in MEMBERSE.'
  107. ?? date()
  108. ? 'This routine clears any names in the EDIRFILE that do not match in MEMBERSE'
  109. Accept 'OK? ' to xx
  110.      If !(xx)='Y'
  111.        Do while spact=sfield
  112.          Store $(spact,15,11) to nfind
  113.          Store trim($(spact,27,10)) to ffind
  114.          Select primary
  115.          Store F to nfound
  116.          If NFIND<>'           '
  117.           Find &NFIND
  118.           If #<>0
  119.            Do while last:name=nfind .and. first:name<>ffind.and. .not. EOF
  120.              SKIP
  121.            enddo
  122.            If last:name=nfind.and. first:name=ffind
  123.              Store T to nfound
  124.            endif
  125.           endif
  126.           If nfound
  127.            If $(S.spact,6,9)=room
  128.              ? room,'   ',nfind,ffind,'   > > >   VERIFIED   < < <'
  129.            else
  130.              ? room,'   ',nfind,ffind,'   Lodging does not match in MEMBERSE '
  131.              Select secondary
  132.              SKIP -1
  133.              Store str(#,5) to orec
  134.              SKIP
  135.              Replace spact with $(spact,1,14)
  136.              GOTO &orec
  137.            endif
  138.           else
  139.            ? '             ',nfind,ffind,'   Name is not found in MEMBERSE.'
  140.            Select secondary
  141.            SKIP -1
  142.            Store str(#,5) to orec
  143.            SKIP
  144.            Replace spact with $(spact,1,14)
  145.            GOTO &OREC
  146.           endif
  147.          endif
  148.          Select secondary
  149.          SKIP
  150.        enddo
  151.      endif
  152.    CASE !(xsel)='A'
  153.     If II>39
  154. Accept 'Maximum assignments for this Lodging have been reached. Press <retn>' ;
  155. to xx
  156.     else
  157.      Select secondary
  158.      Store xsel+'      ' to xsel
  159.      If $(xsel,2,5)='     '
  160.          Accept 'Enter a Room/Bed assignment ' to inbed
  161.          Store inbed+'    ' to inbed
  162.      else
  163.          Store $(xsel,2,5) to inbed
  164.          Store 'A     ' to xsel
  165.        endif
  166.        Store $(inbed,1,5) to inbed
  167.        If !(inbed)<>'Q    '  .and. inbed<>'     '
  168.          Store ' ' to names
  169.          Store T to RBCHANGE
  170.          Store F to RBAPPEND
  171.          Store sfield+inbed to infind
  172.          Find &infind
  173.          If #<>0
  174.            Store str(#,5) to oldrec
  175.            If $(spact,15,10)<>'         '
  176.              ? 'This Room/Bed code found with name - ',$(spact,15,22)
  177.              ? 'No Add made.'
  178.              Store F to RBCHANGE
  179.            endif
  180.          else
  181.            Store T to RBappend
  182.          endif
  183.          If RBCHANGE
  184.            ? 'Enter a new name for this Room/Bed.'
  185.            Select primary
  186.            Do CSECHECK.CMD
  187.            If FOUND
  188.             Store F to CHOLD
  189.             Store $(last:name,1,11)+' '+$(first:name,1,10) to names
  190.             If ROOM = '         '
  191.               Store T to CHOLD
  192.               Replace room with $(infind,6,9)
  193.             else
  194.               Store $(room,5,5) to xx
  195.               Store 'ROOM='+room to nnfind
  196.               Store $(last:name,1,11)+' '+$(first:name,1,10) to names
  197.               Select secondary
  198.               Find &nnfind
  199.               If #=0 .or. names<>$(spact,15,22)
  200.                 Store T to CHOLD
  201.                 ? nnfind,' is not valid for - ',names,'Now being replaced.'
  202.                 Select primary
  203.                 Replace room with ' '
  204.               else
  205.                 ? 'This name already has a Room/Bed. You must select another.'
  206.               endif
  207.             endif
  208.           else
  209.             ? 'This Room/Bed is added without a name.'
  210.             store T to chold
  211.             store T to RBAPPEND
  212.           endif   * FOUND
  213.           If CHOLD
  214.             Select secondary
  215.             If RBappend
  216.               Append blank
  217.               Store II+1 to II
  218.             else
  219.               GOTO &oldrec
  220.             endif
  221.             ? 'New Room/Bed assignment: ',$(infind,6,9),'-->',names
  222.             Replace spact with infind+names
  223.           endif
  224.          endif * #<>0
  225.       endif  * valid "inbed"
  226.      Store 'A' to xsel
  227.    CASE !(XSEL)='C' .or. !(XSEL)='D'
  228.      Do CSELCHNG.CMD
  229.    CASE !(xsel)='R'
  230.       Release inbed,nnfind,ffind,oldrec,chold
  231.       GOTO &xrec
  232.       SKIP
  233.       Set format to print
  234.       Store ROMNAME+'   '+ename to xx
  235.       If len(xx)>60
  236.         Store $(xx,1,60) to xx
  237.       endif
  238.       @ 1,0 say xx
  239.       @ 1,62 say curdate
  240.       Store 1 to I
  241.       Store 3 to J
  242.       Store str(#,5) to irec
  243.       Store '    0' to jrec
  244.       Do while I<21.and.spact=sfield.and..not.EOF
  245.         SKIP
  246.         Store I+1 to I
  247.       enddo
  248.       If spact=sfield
  249.         Store str(#,5) to Jrec
  250.       endif
  251.       GOTO &IREC
  252.       Store 3 to I
  253.       Do while (spact=sfield .and. I<23) .and. .not. EOF
  254.         @ I,3 say $(spact,9,30)
  255.         SKIP
  256.         Store str(#,5) to irec
  257.         If jrec<>'    0'
  258.           GOTO &jrec
  259.           @ I,40 say $(spact,9,30)
  260.           SKIP
  261.           Store str(#,5) to jrec
  262.           If spact<>sfield
  263.             Store '    0' to jrec
  264.           endif
  265.         endif
  266.         Store I+1 to I
  267.         GOTO &IREC
  268.       enddo
  269.       EJECT
  270.       Set format to screen
  271.  CASE !(xsel)='Q' .or.!(xsel)='S' .or. xsel=' '
  272.  otherwise
  273.    ? 'Invalid entry. Please enter again '
  274.  endcase
  275.  ?
  276. enddo
  277. enddo
  278. endif
  279. Release infield,romname,sfield,xrec,I,J,nobed,inbed,infind,found,names
  280. Release nfind,nnfind,ffind,nfound,oldrec,CHOLD,irec,jrec
  281. RETURN
  282. r. !(XSEL)='D'
  283.      Do CSELCHNG.CMD
  284.    CASE !(xsel)='R'
  285.       Release inbed,nnfind,ffind,oldrec,chold
  286.       GOTO &xrec
  287.       SKIP
  288.       Set format to print
  289.       Store ROMNAME+'   '+ename to xx
  290.       If len(xx)>60
  291.         Store $(xx,1,60) to xx
  292.       endif
  293.       @ 1,0 say xx
  294.