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