home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / chrchpr4.zip / MPRSETUP.CMD < prev    next >
OS/2 REXX Batch file  |  1987-01-06  |  7KB  |  209 lines
  1. * Program MPRSETUP - Sets up all functions for running MPROFILE
  2. Store T to LEVEL2
  3. Do while LEVEL2
  4.   Erase
  5.   @ 2,1 say chname
  6.   @ 2,62 say curdate
  7.   @ 3,1  say 'DATA DISK = '+D
  8.   @ 4,17 say ' MPROFILE Set-up Functions                      8-/MPRSETUP/'
  9.   @ 7,9 say  '1)  Create Initial MEMBERS File'
  10.   @ 8,9 say  '2)  Re-index MEMBERS File'
  11.   @ 9,9 say  '3)  Re-index a specified file'
  12.   @ 10,9 say '4)  Names Directory - church, computer parameters     /MCNAMESC/'
  13.   @ 11,9 say '5)  Names Directory - Activity Names editing          /MCNAMES /'
  14.   @ 12,9 say '6)  Printer start-up - initializes print characters'
  15.   @ 13,9 say '7)  Copy a file to external format'
  16.   @ 14,9 say '8)  Purge MEMBERS file of Inactive People'
  17. ?
  18. Accept '         Select one of the above operations ("Q" = quit) ' to MSEL
  19. ?
  20. Store F to valid2
  21. Do while .NOT. valid2
  22.   Store T to valid2
  23.   Do CASE
  24.     CASE MSEL = '1'
  25.       Use MEMBERSX
  26.       Store 'in order to create a new, empty one.' to XX
  27.       Store XX+' It also initializes the MDIRFILE (Names Directory).' to XX
  28.       ? 'WARNING - This routine wipes out the existing MEMBERS file ',XX
  29.       Accept 'Are you sure you want to do this? ' to XX
  30.       If !(XX)='Y'
  31.         ? 'Now creating a new, empty MEMBERS file.'
  32.         Store D+':MEMBERS' to MFILE
  33.         Copy Structure to &MFILE
  34.         Use &MFILE
  35.         Index on last:name+first:name to &MFILE
  36.         ? 'File',MFILE,', index',MFILE,'has now been created.'
  37.   Accept 'Do you want to initialize the Names Directory (MDIRFILE) too? ' to XX
  38.         If !(XX)='Y'
  39.         Use MDIRFILX
  40.         Copy to MDIRFILE
  41.         USE MDIRFILE index MDIRFILE
  42.         index on spact to MDIRFILE
  43.         USE
  44.         endif
  45.       endif
  46.     CASE MSEL = '2' .or. MSEL = '3'
  47.       If MSEL='2'
  48.         Store d+':MEMBERS' to MFILE
  49.         Store 'last:name+first:name' to MFILEKEY
  50.         Store MFILE to MFILENDX
  51.       else
  52.         Accept 'Enter name of file to be indexed ' to MFILE
  53.         If !(MFILE)='MDIRFILE'
  54.           Store MFILE to MFILENDX
  55.           Store 'SPACT' to MFILEKEY
  56.         else
  57.           Store d+':'+MFILE to MFILE
  58.           Accept 'Enter fields to be indexed on ' to MFILEKEY
  59.           Accept 'Enter new index file name ' to MFILENDX
  60.         endif
  61.       endif
  62.       If file(MFILE)
  63.         Use &MFILE
  64. ? 'Now indexing file',MFILE,'by',MFILEKEY,'creating index',MFILENDX
  65.         Set talk on
  66.         Index on &MFILEKEY to &MFILENDX
  67.         Set talk off
  68.         Use
  69.       else
  70.         ? 'File',MFILE,'does not exist. '
  71.       endif
  72.     CASE MSEL = '4'
  73.       Do MCNAMESC.CMD
  74.       Store T to validd1
  75.       RETURN
  76.     CASE MSEL = '5'
  77.       Do MCNAMES.CMD
  78.       Store T to validd1
  79.     CASE MSEL = '6'
  80.       USE MDIRFILE
  81.       GOTO 18
  82.       STORE 13 TO INCHNUM
  83.       ? 'Turn the printer on . . .'
  84.       STORE $(SPACT,INCHNUM,2) TO INCHAR
  85.       Set format to print
  86.       Do while inchar<>' ' .and. inchnum<30
  87.         Store val(inchar) to inchval
  88.         @ 0,inchnum say chr(inchval)
  89.         ? 'ASCII ',inchar
  90.         Store inchnum+3 to inchnum
  91.         STORE $(spact,inchnum,2) to inchar
  92.       enddo
  93.       Release inchar,inchval,inchnum
  94.       Set format to screen
  95.       USE
  96.       ? 'Printer is now initialized.'
  97.     CASE MSEL = '7'
  98.       Accept 'Enter file name to be copied ' to MFILE
  99.       Store d+':&MFILE' to MFILE
  100.       If .not. file(MFILE)
  101.         Accept 'File not found on data disk. Press <retn>' to MFILE
  102.       else
  103.         Accept 'Enter file index name, or <retn> for none ' to MFILENDX
  104.         If MFILENDX<>' '
  105.         Store d+':&MFILENDX'+'.NDX' to MFILENDX
  106.         If .not. file(MFILENDX)
  107.           ? 'Index file',MFILENDX,'not found.'
  108.           Accept 'Press <retn> ' to MFILE
  109.           RETURN
  110.         else
  111.           Store mfile+' index '+MFILENDX to MFILE
  112.         endif
  113.         endif
  114.         USE &MFILE
  115.         Accept 'Enter selection criteria, or <retn> for none ' to MFILESEL
  116.         ? 'WARNING: The new file will be erased if it already exists.'
  117.         Accept 'Enter new file name ' to MNFILE
  118.         If MFILESEL=' '
  119.           Store ' ' to XFOR
  120.         else
  121.           Store ' for' to XFOR
  122.         endif
  123.         Store d+':MNFILE' to MNFILE
  124.         ? 'Now copying',MFILE,'to',MNFILE,XFOR,MFILESEL
  125.        If MFILESEL=' '
  126.         Set talk on
  127.         Copy to &MNFILE SDF
  128.         Set talk off
  129.        else
  130.         Set talk on
  131.         Copy to &MNFILE for &MFILESEL SDF
  132.         Set talk off
  133.         Accept 'Press <retn> ' to XX
  134.        endif
  135.       endif
  136.     CASE MSEL = '8'
  137.       Store $(date(),7,2) to INYEAR
  138.       Set raw on
  139.       ? 'Note:  THIS ROUTINE PRINTS OUT, THEN DELETES ALL MEMBER RECORDS THAT'
  140.       ? '       WERE MADE INACTIVE BEFORE THIS YEAR [19',INYEAR,']'
  141.       Set raw off
  142.       ACCEPT 'OK? ' TO XX
  143.       IF !(XX)='Y'
  144.       ?
  145.       ? 'Ready the printer.'
  146.       Store d+':MEMBERS' to MFILE
  147.       USE &MFILE
  148.       Set console off
  149.       Store d+':offerndx.ndx' to nfile
  150.       Delete file &nfile
  151.       Store d+':ssscmemb.ndx' to nfile
  152.       Delete file &nfile
  153.       Set console on
  154.       Store 0 to page
  155.       Store 66 to curline
  156.       ? 'Now marking records to be PURGED.'
  157.       Set format to print
  158.       Store 0 to recnum
  159.       Store 0 to recc
  160.       Do while .not. EOF
  161.         If curline > 60
  162.           If page>0
  163.             EJECT
  164.           endif
  165.           Store page+1 to page
  166.           Store str(page,3) to pagenum
  167.           @ 1,20 say 'PURGED RECORDS - ',date()+'   Page'+pagenum
  168.           Store 3 to curline
  169.         endif
  170.         If $(membstatus,2,1)='*' .and. $(dates,8,2)<>inyear
  171. @ curline,0 say '#'+str(#,4)+' '+ss:sc:memb+$(membstatus,1,6)+familycode+'  '+;
  172.       $(first:name,1,10)+' '+last:name+$(address,1,12)+dates
  173.           Store curline+2 to curline
  174.           DELETE
  175.         endif
  176.         SKIP
  177.         Store recc+1 to recc
  178.         If recc=100
  179.           Store 100+recnum to recnum
  180.           Store 0 to recc
  181.           ? str(recnum,5),'RECORDS PROCESSED'
  182.         endif
  183.       ENDDO
  184.       EJECT
  185.       Set format to screen
  186.       USE &MFILE
  187.       ? 'Now PACKING the MEMBERS file.'
  188.       Set talk on
  189.       PACK
  190.       ? 'Now re-indexing the MEMBERS file.'
  191.       Use &MFILE
  192.       Index on last:name+first:name to &MFILE
  193.       Set talk off
  194.       Use
  195.       ENDIF
  196.     CASE !(MSEL) = 'Q'
  197.       Store F to LEVEL2
  198.       RETURN
  199.     OTHERWISE
  200.       Accept 'Illegal selection. Please enter again ' to MSEL
  201.       Store F to valid2
  202.   ENDCASE
  203. ENDDO
  204. If LEVEL2
  205.   Accept 'Processing is complete. Press <retn> ' to XX
  206. endif
  207. enddo
  208. RETURN
  209.