home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr3.zip
/
MCONTRIB.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1991-01-21
|
7KB
|
266 lines
* Program MCONTRIB - Controls all Contributions program functions
Clear
Set talk off
Set deleted on
Set intensity off
?
? 'Now loading the MCONTRIB Program'
Select secondary
Use CDIRFILE index CDIRFILE
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
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
GOTO 1
Store trim($(SPACT,4,27)) to CHNAME
SKIP
Store $(SPACT,21,1) to D
Store curmonthx+curyear to curdate
Release curmonthx,curmonth,indate,nmonth,curmo
GOTO 3
Store $(spact,27,4) to cyearcon
SKIP
Store val($(spact,3,2)) to NN
Store trim($(months,NN*9-8,9)) to CMONTHCO
If $(spact,28,2)=' '
Store $(spact,3,24) to curdates
else
Store $(SPACT,3,29)+' ' to curdates
endif
SKIP
If $(spact,3,29)=' '
SKIP
else
If $(spact,28,2)=' '
Store curdates+$(spact,3,24) to curdates
else
Store curdates+$(spact,3,29)+' ' to curdates
endif
SKIP
If $(spact,28,2)=' '
Store curdates+$(spact,3,24) to curdates
else
Store curdates+$(spact,3,29)+' ' to curdates
endif
endif
GOTO 7
If !($(spact,30,1))='Q'
Store 15 to wknummax
GOTO 6
Store val($(spact,3,2)) to NN
Store trim($(months,NN*9-8,9)) to cmonthco
else
Store 6 to wknummax
endif
GOTO 8
Store val($(spact,28,4)) to MAXOFFER
Store maxoffer to OFFERMAX
SKIP
Store F to pageprnt
If !($(SPACT,26,1))='Y'
Store T to pageprnt
endif
GOTO 12
STORE 'X' TO OCATNAM0
Store '0' to N
Store ' ' to HDR3
Do while OCATNAM&N<>' ' .and. N<>'4'
Store str(val(N)+1,1) to N
Store $(spact,21,10) to OCATNAM&N
Store HDR3+' '+OCATNAM&N to HDR3
SKIP
enddo
If N = '4'
If OCATNAM4=' '
STORE $(HDR3,1,37) TO HDR3
ELSE
Store '5' to N
endif
endif
Store ' TOTAL ' to OCATNAM&N
Store HDR3+' '+OCATNAM&N to HDR3
Store N to OT
GOTO 16
Store ' ' to CSA
If !($(spact,29,1))='Y'
GOTO 49
Store trim($(spact,2,38)) to CSA
GOTO 50
Store trim(CSA+$(spact,2,38)) to CSA
endif
GOTO 27
If $(spact,3,29)=' '
Store F to OFFNOTE
else
Store T to OFFNOTE
endif
Release validd1,msel,months,level1,nn,ocatnam0,curyear
Store D+':contrib' to MFILE
Use
Select primary
Store T to CONTINU
Do while CONTINU
Set format to screen
Erase
@ 1,1 say chname
@ 1,62 say curdate
@ 2,1 say 'DATA DISK = '+D
@ 3,15 say ' CHURCH CONTRIBUTIONS ENTRY AND REPORTING '1-/MCONTRIB/'
@ 6,9 SAY '1) Perform a new month initialize'
@ 6,69 SAY '/MCONINIT/'
@ 7,9 say '2) Perform weekly entering of church offerings'
@ 7,69 SAY '/MCONINPU/'
@ 8,9 say '3) Generate end-of-period office report of all offerings'
@ 8,69 SAY '/MCONREPT/'
@ 9,9 say ' plus create the new next-period file CONTRIBX'
@ 10,9 say '4) Create the new next-period file CONTRIBX'
@ 10,69 SAY '/MCONREPT/'
@ 11,9 say '5) Generate individual offering statements'
@ 11,69 SAY '/MCONSTAT/'
@ 12,9 say '6) Direct Display/Editing of the CONTRIB file, PLEDGED'
@ 12,69 say '/MCONFILE/'
@ 13,9 say '7) Contributions Analysis Reports'
@ 13,69 say '/MCANALYS/'
@ 14,9 say '8) Special Funds processing'
@ 14,69 say '/MCSFUNDS/'
@ 15,9 say '9) SET UP'
@ 15,69 say '/CFNAMESC/'
?
Accept ' Enter selection ' to OSEL
?
If !(osel)='DISK='
Store !($(osel,6,1)) to D
? 'Disk now being set to drive',D
Save to MEMVARSC
else
Store $(osel,1,1) to xx
Do while @(xx,'123456789Qq')=0
Accept 'Invalid entry. Please enter again ' to XX
Store $(xx,1,1) to osel
enddo
If osel='9'
?
? 'Select: 1) Start a new CONTRIBX file (for a new year)'
? ' 2) Printer start-up, special characters'
Accept ' 3) Edit the Names Directory (CDIRFILE) ' to XX
If XX='2'
Select secondary
Use CDIRFILE
GOTO 23
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,inchunm,inchval
Set format to screen
Use
? 'Printer is now initialized.'
endif
If XX='1'
Store str(MAXOFFER,4) to xx
? 'This routine deletes any existing CONTRIBX file, then makes another, with'
? 'all contribution values being zero. The envelope number count is',xx
? 'as found in the Names Directory file (CDIRFILE).'
Accept 'Ok? ' to XX
If !(XX)<>'Y'
Accept 'No changes made. Press <RETURN>' to xx
else
Store d+':CONTRIBX' to MFILE
If wknummax=6
USE CONTRIBT
else
USE CONTRIBU
endif
Copy structure to &MFILE
Use &MFILE
Store 0 to recnum
Store 0 to recc
Do while recnum<maxoffer
Store recnum+1 to recnum
Store recc+1 to recc
Append blank
If recc=100
Store 0 to recc
? recnum,' RECORDS made'
endif
enddo
? recnum,' RECORDS MADE'
Release recc,recnum,xx
Accept 'CONTRIBX file is complete. Press <retn> ' to XX
endif
else
If XX='2'
Do CFNAMESC.CMD
else
Accept 'Invalid selection. Press <RETURN>' to xx
endif
endif
else
Store D+':CONTRIB' to MFILE
If .not.file(MFILE)
? 'CONTRIB file is not present on the data disk. Perform SET UP to create it.'
?
Accept 'Press <RETURN> to continue' to xx
else
Select primary
Use &MFILE
Do case
CASE OSEL = '1'
Do MCONINIT.CMD
CASE OSEL = '2'
Save to MEMVARSC
Do MCONINPU.CMD
Restore from MEMVARSC
CASE OSEL = '3' .or. OSEL = '4'
Do MCONREPT.CMD
CASE OSEL = '5'
Save to MEMVARSC
Do MCONSTAT.CMD
Restore from MEMVARSC
Delete file MEMVARSC.MEM
CASE OSEL = '6'
DO MCONFILE.CMD
CASE OSEL='7'
Do MCANALYS.CMD
CASE OSEL='8'
DO MCSFUNDS.CMD
CASE !(OSEL) = 'Q'
RETURN
ENDCASE
endif
endif
endif
ENDDO
endif
USE
ENDDO
RETURN
xisting CONTRIBX file, then makes another, with'
? 'all contribution values being zero. The envelope number count is',xx
? 'as found in the Names Directory file (CDIRFILE).'
Accept 'Ok? ' t