home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr2.zip
/
CTAPELIB.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1987-01-06
|
10KB
|
358 lines
* Program CTAPELIB - Manages tape label records
Clear
Set intensity off
Set talk off
Set deleted on
Store 'January February March April May June ' to MONTHS
Store MONTHS+'July August SeptemberOctober November December ' to MONTHS
If $(DATE(),7,2) = '00'
Set date to 01,01,00
ENDIF
Store ' ' to curmonthx
Store ' ' to curyear
Store ' ' to curmonth
* Set today's date from current system-date
Store $(date(),1,2) to curmo
Store $(date(),7,2) to curmonthx
Store val(curmo) to nmonth
Store curmo+curmonthx to indate
Store VAL(curmonthx) to CURYEAR
If $(date(),4,1) = '0'
Store $(DATE(),5,1) to CURMONTHX
else
Store $(DATE(),4,2) to CURMONTHX
endif
Store trim($(months,NMONTH*9-8,9)) to curmonth
Store curmonth+' '+curmonthx to curmonthx
Store ', 19'+$(DATE(),7,2) to CURYEAR
Store curmonthx+curyear to curdate
Select primary
Use UDIRFILE
release curmo,months,curyear,curmonthx
GOTO 2
Store !($(spact,21,1)) to D
GOTO 5
Store val($(spact,28,2)) to labellpp
SKIP
Store val($(spact,28,2)) to labelspa
SKIP
Store val($(spact,28,2)) to labl1col
Store d+':TLABELS.NDX' to MFILENDX
Set talk off
Store T to continue
Do while continue
USE
Select primary
Use
Store D+':TLABELS' to MFILE
ERASE
@ 1,1 say 'DATA DISK = '+D
@ 1,60 say curdate
@ 2,20 say 'TAPE LABELS Program'
@ 5,9 say '1. Enter new labels'
@ 6,9 say '2. Print labels '
@ 7,9 say '3. Edit an existing label'
@ 8,9 say '4. Print all existing labels by date, on the printer'
@ 9,9 say '5. Create a new, empty TLABELS file'
@ 10,9 say '6. Names Directory Editing'
?
Accept ' Enter selection ' to ESEL
?
If !(ESEL)='DISK='
If len(ESEL)>5
Store !($(ESEL,6,1)) to D
? 'Now changing the data disk to drive',D
Store D+':TLABELS' to MFILE
endif
Store D to ESEL
endif
Do while @(ESEL,'123456QqD')=0
Accept 'Invalid entry. Please enter again ' to ESEL
enddo
If ESEL<>'6'.and.!(ESEL)<>'Q'
If file(MFILE)
Use &MFILE index &MFILE
else
? 'File',MFILE,'not found on the data disk. Perform SET UP to create it.'
?
endif
endif
Do case
Case ESEL = '1'
Store 'Y' to level2
Do while !(LEVEL2)<>'N' .and. !(LEVEL2)<>'Q'
ERASE
Store ' ' to xtitle,xtitle2,xtext
Store ' ' to xspeaker
Store ' ' to XDATE
@ 2,20 say 'Tape Labels - New entry'
@ 5,3 say 'TITLE ' get xtitle
@ 6,12 get XTITLE2
@ 7,3 say 'TEXT ' get xtext
@ 8,3 say 'SPEAKER ' get XSPEAKER
@ 9,3 say 'DATE ' get xdate
@ 9,43 say 'SERIES ' get series
@ 11,20 say 'Press ctrl-W when finished.'
READ
If xtitle<>' '
Append blank
Replace title with xtitle
Replace title2 with xtitle2
Replace text with xtext
Replace speaker with xspeaker
Replace date with xdate
Replace DATESORT with $(DATE,7,2)+$(date,1,2)+$(DATE,4,2)+$(date,10,1)
else
? 'TITLE is blank. No entry is made.'
endif
Accept 'Another? ' to LEVEL2
enddo
Use &MFILE index &MFILE
Case ESEL = '2'
Store 'Y' to LEVEL2
Do while !(LEVEL2)<>'Q' .and. !(LEVEL2)<>' ' .and. !(level2)<>'N'
Store T to invalid1
Do while invalid1
? 'Enter the date designator of the label you desire.'
? 'Date designator format: MM/DD/YY,T (month/day/year,time)'
Accept ' ' to indate
If !(indate)='Q' .or. ' '=indate
Store 'Q' to level2
Store F to invalid1
else
If $(indate,2,1) = '-' .or. $(indate,2,1) = '/'
Store ' '+indate to indate
endif
Store len(trim(indate)) to lenind
If lenind<10
Accept 'Date designator is too short. Enter again' to indate
else
Store $(indate,7,2)+$(indate,1,2)+$(indate,4,2)+$(indate,10,1) to indatex
Find &indatex
If # = 0
? 'No label record found with this date:',indate
else
Store F to invalid1
endif
endif
ENDDO
If !(level2)<>'Q'
Accept 'Enter the number of label copies wanted' to tln
Store val(tln) to tlnumb
Store 0 to lnumb
Store labellpp-2 to lbpage
Do while tlnumb > 0
Set format to print
Store lnumb to linenum
Store tlnumb-1 to tlnumb
Store len(trim(title)) to titlelen
Store (32-titlelen)/2 to inset
@ linenum,labl1col+inset say title
Store len(trim(title2)) to titlelen
If titlelen <> 1
Store (32-titlelen)/2 to inset
@ linenum+1,labl1col+inset say title2
Store linenum+1 to linenum
endif
@ linenum+1,labl1col say text
@ linenum+2,labl1col say speaker
@ linenum+2,labl1col+24 say date
Store lnumb+labelspa to lnumb
If lnumb>lbpage
EJECT
Store 0 to lnumb
endif
enddo
If lnumb<=lbpage
EJECT
endif
Set format to screen
?
ACCEPT 'Another? ' to level2
endif
endif
ENDDO
CASE ESEL = '3'
Store 'Y' to invalid9
Do while !(invalid9)<>'N'.and.invalid9<>' '.and.!(invalid9)<>'Q'
Store T to invalid1
? 'Enter date to the desired tape'
? 'Date format is: MM/DD/YY,T'
Accept ' ' to inlabl
Do while invalid1
If !(inlabl) = 'Q'
Store 'Q' to invalid9
Store F to invalid1
else
If $(inlabl,2,1) = '-' .or. $(inlabl,2,1) = '/'
Store ' '+inlabl to inlabl
endif
Store len(inlabl) to lenlabl
If lenlabl<10
Accept 'Invalid date designator [MM/DD/YY,T]. Please re-enter ' to inlabl
else
Store $(inlabl,7,2)+$(inlabl,1,2)+$(inlabl,4,2)+$(inlabl,10,1) to inlablx
Find &inlablx
If # = 0
Accept 'Record not found. Enter again: ' to inlabl
else
Store F to invalid1
endif
endif
endif
enddo
If !(invalid9)<>'Q'
Store F to GOODREC
Do while .not. GOODREC
ERASE
@ 2,20 say 'Tape Labels - Modifying an old entry'
@ 5,8 say 'TITLE ' get title
@ 6,17 get title2
@ 7,8 say 'TEXT ' get text
@ 8,8 say 'SPEAKER ' get speaker
@ 9,8 say 'DATE ' get date
@ 9,40 say 'SERIES ' get series
@ 11,20 say 'Press ctrl-W when finished'
READ
Store T to goodrec
@ 12,0 say ' '
If len(trim(date))>8
If len(trim(date))=9 .and. ($(date,2,1)='/'.or.$(date,2,1)='-')
Replace DATE with ' '+date
endif
else
? 'The date field must have at least 9 characters. Please re-enter.'
Store F to goodrec
endif
Replace datesort with $(date,7,2)+$(date,1,2)+$(date,4,2)+$(date,10,1)
enddo
endif
Accept 'Another? ' to invalid9
enddo
USE &MFILE index &MFILE
Case ESEL = '4'
?
Accept 'Enter a starting label date, or press <retn> for all' to inlabl
If inlabl = ' '
GOTO top
else
Store T to invalid2
Do while invalid2
If $(inlabl,2,1) = '-' .or. $(inlabl,2,1) = '/'
Store ' '+inlabl to inlabl
endif
If len(inlabl) < 10
Accept 'Invalid label designator. Please re-enter: ' to inlabl
else
Store $(inlabl,7,2)+$(inlabl,1,2)+$(inlabl,4,2)+$(inlabl,10,1) to inlablx
Find &inlablx
If # = 0
Accept 'Label designator not found. Please re-enter: ' to inlabl
else
Store F to invalid2
endif
endif
enddo
endif
Store 1 to pgnumb
Store 99 to linenumb
Set format to print
Do while .not. EOF
If linenumb > labellpp
If linenumb<>99
EJECT
endif
Store STR(PGNUMB,4) to pgnumbr
@ 2,2 say 'Tape Labels - '+curdate+' Page'+pgnumbr
Store 5 to linenumb
endif
If title2=' '
@ linenumb+1,4 say title
else
@ linenumb,4 say title
@ linenumb+1,4 say title2
endif
@ linenumb+2,4 say text
@ linenumb+3,4 say speaker
@ linenumb+4,4 say date
@ linenumb+4,30 say series
Store linenumb+6 to linenumb
SKIP
ENDDO
EJECT
Set format to screen
Accept 'Report is complete. Press <RETURN> ' to XX
Case ESEL='5'
Accept ;
'This process clears any existing TLABELS file and makes a new one. OK?' to XX
If !(XX)='Y'
Store 'TLABELX.DBF' to MFILEX
If file(MFILEX)
use &MFILEX
Copy to &MFILE
USE &MFILE
Index on datesort to &MFILE
Accept 'New TLABELS file is now created. Press <RETN> ' to XX
else
Accept 'File TLABELX not found on the program disk. Press <RETURN>' to XX
endif
endif
Store d+':TLABELS' to MFILE
USE &MFILE index &MFILE
Case !(ESEL)='6'
Use UDIRFILE
?
? ' Editing CTAPELIB Names Directory parameters'
Use udirfile
GOTO 2
Store $(SPACT,21,1) to MD2
GOTO 5
Store $(spact,28,2) to MD4
SKIP
STORE $(SPACT,28,2) TO MD5
SKIP
Store $(spact,28,2) to MD6
@ 18,0 say 'Disk I.D. containing data files ' get MD2
@ 19,0 SAY 'Tape Labels, LINES PER PAGE ' GET MD4
@ 20,0 SAY 'Tape Labels, labels spacing' GET MD5
@ 21,0 SAY 'Tape Labels, 1st column ' GET MD6
READ
?
Accept ' SAVE? ' to MDX
If !(MDX)='Y'
GOTO 2
Replace spact with $(SPACT,1,20)+MD2
Store !(MD2) to D
GOTO 5
Replace spact with $(spact,1,27)+MD4
Store val(MD4) to labellp
SKIP
Replace spact with $(spact,1,27)+MD5
Store val(MD5) to labelspa
SKIP
Replace spact with $(spact,1,27)+MD6
Store val(MD6) to labl1col
SKIP
endif
Case !(ESEL) = 'Q'
Store F to continue
endcase
enddo
USE
Store T to validd1
RETURN
= 'Q'
Store F to continue
endcase
enddo
USE
Store T to validd1
RETURN
,17 get title2
@ 7,8 say 'TEXT ' get text
@ 8,8 say 'SPEAKER ' get speaker
@ 9,8 say 'DATE ' get date
@ 9,40 say 'SERIES ' get series
@ 11,20 say 'Press ctrl-W when finished'
READ
Stor