home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr4.zip
/
MPRSETUP.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1987-01-06
|
7KB
|
209 lines
* Program MPRSETUP - Sets up all functions for running MPROFILE
Store T to LEVEL2
Do while LEVEL2
Erase
@ 2,1 say chname
@ 2,62 say curdate
@ 3,1 say 'DATA DISK = '+D
@ 4,17 say ' MPROFILE Set-up Functions 8-/MPRSETUP/'
@ 7,9 say '1) Create Initial MEMBERS File'
@ 8,9 say '2) Re-index MEMBERS File'
@ 9,9 say '3) Re-index a specified file'
@ 10,9 say '4) Names Directory - church, computer parameters /MCNAMESC/'
@ 11,9 say '5) Names Directory - Activity Names editing /MCNAMES /'
@ 12,9 say '6) Printer start-up - initializes print characters'
@ 13,9 say '7) Copy a file to external format'
@ 14,9 say '8) Purge MEMBERS file of Inactive People'
?
Accept ' Select one of the above operations ("Q" = quit) ' to MSEL
?
Store F to valid2
Do while .NOT. valid2
Store T to valid2
Do CASE
CASE MSEL = '1'
Use MEMBERSX
Store 'in order to create a new, empty one.' to XX
Store XX+' It also initializes the MDIRFILE (Names Directory).' to XX
? 'WARNING - This routine wipes out the existing MEMBERS file ',XX
Accept 'Are you sure you want to do this? ' to XX
If !(XX)='Y'
? 'Now creating a new, empty MEMBERS file.'
Store D+':MEMBERS' to MFILE
Copy Structure to &MFILE
Use &MFILE
Index on last:name+first:name to &MFILE
? 'File',MFILE,', index',MFILE,'has now been created.'
Accept 'Do you want to initialize the Names Directory (MDIRFILE) too? ' to XX
If !(XX)='Y'
Use MDIRFILX
Copy to MDIRFILE
USE MDIRFILE index MDIRFILE
index on spact to MDIRFILE
USE
endif
endif
CASE MSEL = '2' .or. MSEL = '3'
If MSEL='2'
Store d+':MEMBERS' to MFILE
Store 'last:name+first:name' to MFILEKEY
Store MFILE to MFILENDX
else
Accept 'Enter name of file to be indexed ' to MFILE
If !(MFILE)='MDIRFILE'
Store MFILE to MFILENDX
Store 'SPACT' to MFILEKEY
else
Store d+':'+MFILE to MFILE
Accept 'Enter fields to be indexed on ' to MFILEKEY
Accept 'Enter new index file name ' to MFILENDX
endif
endif
If file(MFILE)
Use &MFILE
? 'Now indexing file',MFILE,'by',MFILEKEY,'creating index',MFILENDX
Set talk on
Index on &MFILEKEY to &MFILENDX
Set talk off
Use
else
? 'File',MFILE,'does not exist. '
endif
CASE MSEL = '4'
Do MCNAMESC.CMD
Store T to validd1
RETURN
CASE MSEL = '5'
Do MCNAMES.CMD
Store T to validd1
CASE MSEL = '6'
USE MDIRFILE
GOTO 18
STORE 13 TO INCHNUM
? 'Turn the printer on . . .'
STORE $(SPACT,INCHNUM,2) TO INCHAR
Set format to print
Do while inchar<>' ' .and. inchnum<30
Store val(inchar) to inchval
@ 0,inchnum say chr(inchval)
? 'ASCII ',inchar
Store inchnum+3 to inchnum
STORE $(spact,inchnum,2) to inchar
enddo
Release inchar,inchval,inchnum
Set format to screen
USE
? 'Printer is now initialized.'
CASE MSEL = '7'
Accept 'Enter file name to be copied ' to MFILE
Store d+':&MFILE' to MFILE
If .not. file(MFILE)
Accept 'File not found on data disk. Press <retn>' to MFILE
else
Accept 'Enter file index name, or <retn> for none ' to MFILENDX
If MFILENDX<>' '
Store d+':&MFILENDX'+'.NDX' to MFILENDX
If .not. file(MFILENDX)
? 'Index file',MFILENDX,'not found.'
Accept 'Press <retn> ' to MFILE
RETURN
else
Store mfile+' index '+MFILENDX to MFILE
endif
endif
USE &MFILE
Accept 'Enter selection criteria, or <retn> for none ' to MFILESEL
? 'WARNING: The new file will be erased if it already exists.'
Accept 'Enter new file name ' to MNFILE
If MFILESEL=' '
Store ' ' to XFOR
else
Store ' for' to XFOR
endif
Store d+':MNFILE' to MNFILE
? 'Now copying',MFILE,'to',MNFILE,XFOR,MFILESEL
If MFILESEL=' '
Set talk on
Copy to &MNFILE SDF
Set talk off
else
Set talk on
Copy to &MNFILE for &MFILESEL SDF
Set talk off
Accept 'Press <retn> ' to XX
endif
endif
CASE MSEL = '8'
Store $(date(),7,2) to INYEAR
Set raw on
? 'Note: THIS ROUTINE PRINTS OUT, THEN DELETES ALL MEMBER RECORDS THAT'
? ' WERE MADE INACTIVE BEFORE THIS YEAR [19',INYEAR,']'
Set raw off
ACCEPT 'OK? ' TO XX
IF !(XX)='Y'
?
? 'Ready the printer.'
Store d+':MEMBERS' to MFILE
USE &MFILE
Set console off
Store d+':offerndx.ndx' to nfile
Delete file &nfile
Store d+':ssscmemb.ndx' to nfile
Delete file &nfile
Set console on
Store 0 to page
Store 66 to curline
? 'Now marking records to be PURGED.'
Set format to print
Store 0 to recnum
Store 0 to recc
Do while .not. EOF
If curline > 60
If page>0
EJECT
endif
Store page+1 to page
Store str(page,3) to pagenum
@ 1,20 say 'PURGED RECORDS - ',date()+' Page'+pagenum
Store 3 to curline
endif
If $(membstatus,2,1)='*' .and. $(dates,8,2)<>inyear
@ curline,0 say '#'+str(#,4)+' '+ss:sc:memb+$(membstatus,1,6)+familycode+' '+;
$(first:name,1,10)+' '+last:name+$(address,1,12)+dates
Store curline+2 to curline
DELETE
endif
SKIP
Store recc+1 to recc
If recc=100
Store 100+recnum to recnum
Store 0 to recc
? str(recnum,5),'RECORDS PROCESSED'
endif
ENDDO
EJECT
Set format to screen
USE &MFILE
? 'Now PACKING the MEMBERS file.'
Set talk on
PACK
? 'Now re-indexing the MEMBERS file.'
Use &MFILE
Index on last:name+first:name to &MFILE
Set talk off
Use
ENDIF
CASE !(MSEL) = 'Q'
Store F to LEVEL2
RETURN
OTHERWISE
Accept 'Illegal selection. Please enter again ' to MSEL
Store F to valid2
ENDCASE
ENDDO
If LEVEL2
Accept 'Processing is complete. Press <retn> ' to XX
endif
enddo
RETURN