home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr3.zip
/
MCSFUNDS.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1991-01-21
|
12KB
|
427 lines
*Program MCSFUNDS - Edits Special Account records in CDIRFILE
Store T to LEVEL3
Select secondary
USE CDIRFILE index CDIRFILE
Do while LEVEL3
Erase
@ 1,1 say chname
@ 1,62 say curdate
@ 2,1 say 'DATA DISK = '+D
@ 3,20 say ' CONTRIB Special Funds editing 8-/MCSFUNDS/'
@ 5,9 say '1) Add contributions to Special Funds'
@ 6,9 say '2) Edit Special Fund contributions'
@ 7,9 say '3) Delete Special Fund contributions'
@ 8,9 say '4) Display the Special Fund Letters, names'
@ 9,9 say '5) Add a Special Fund category'
@ 10,9 say '6) Edit a Special Fund category'
@ 11,9 say '7) Delete a Special Fund category'
@ 12,9 say '8) Compute Special Funds totals'
@ 13,9 say '9) Display Special Fund amounts'
?
Accept ' Enter selection ' to MSEL
?
Do while @(MSEL,'123456789Qq')=0
Accept 'Invalid entry. Please enter again ' to MSEL
enddo
?
If !(MSEL)='Q'
Store F to LEVEL3
else
Do CASE
CASE MSEL='1'
Select secondary
? ' Week number dates of this period -'
?
Store 1 to NN
Do while NN<wknummax
?? str(NN,2),' '
Store NN+1 to NN
enddo
?
Store 1 to NN
Do while NN<wknummax
?? $(curdates,NN*6-5,5)
Store NN+1 to NN
enddo
?
Accept 'Enter a week number ' to XX
Do while (val(XX)<1.or.val(XX)>=wknummax) .and. !(XX)<>'Q'
Accept 'Invalid week number. Please enter another ' to XX
enddo
Store val(XX) to wknumb
Store '0' to EN
Do while EN<>'Q'
?
Accept 'Enter an envelope number ("Q"=quit) ' to EN
Do while (val(EN)<0.or.val(EN)>offermax) .and. !(EN)<>'Q'
Accept 'Invalid envelope number. Please enter another ' to EN
enddo
?
If !(EN)<>'Q'
Store val(EN) to envl
? ' Current Special Fund letters: ',CSA
Accept ' Enter a Special Fund letter ' to XX
Store '$'+XX to SFFUND
Find &SFFUND
Do while @(XX,CSA)=0 .or. #=0
Accept 'Invalid Special Fund letter. Please enter another ' to XX
Store '$'+XX to SFFUND
Find &SFFUND
enddo
?
Store 0.00 to NN
?
?
?
@ 22,1 say ;
'Enter amount to be recorded for this envelope number and week, fund' get NN
READ
? 'Now recording $',NN,' into Special Fund =',$(CDIRINDEX,2,11)
? 'for week',$(curdates,wknumb*6-5,6),'and envelope',str(envl,4),'.'
Accept ' OK? ' to xx
If !(XX)='Y'
Append blank
Replace CDIRINDEX with SFFUND+'.'+$(curdates,wknumb*6-5,5)+str(envl,4)
Replace spact with str(NN,11,2)
endif
endif
enddo
CASE MSEL='2' .or. MSEL='3'
Select secondary
? ' Week number dates of this period -'
?
Store 1 to NN
Do while NN<wknummax
?? str(NN,2),' '
Store NN+1 to NN
enddo
?
Store 1 to NN
Do while NN<wknummax
?? $(curdates,NN*6-5,5)
Store NN+1 to NN
enddo
?
Accept 'Enter a week number ' to XX
Do while (val(XX)<1.or.val(XX)>=wknummax) .and. !(XX)<>'Q'
Accept 'Invalid week number. Please enter another ' to XX
enddo
Store val(XX) to wknumb
Store '0' to EN
? 'This process requires you to enter a known envelope number and Special'
? 'Fund letter. Along with the above week number, the program will search for'
If MSEL='2'
? 'a match, and if found, allows changing the values in that record.'
else
? 'a match, and if found, the record is deleted.'
endif
Do while EN<>'Q'
?
Accept 'Enter an envelope number ("Q"=quit) ' to EN
Do while (val(EN)<1.or.val(EN)>offermax) .and. !(EN)<>'Q'
Accept 'Invalid envelope number. Please enter another ' to EN
enddo
?
If !(EN)<>'Q'
Store val(EN) to envl
? ' Current Special Fund letters:',CSA
Accept ' Enter the Special Fund letter ' to XX
Store '$'+XX+'.'+$(curdates,wknumb*6-5,5)+str(envl,4) to SFFUND
Find &SFFUND
If #=0
Accept 'Special Fund not found for these entries. Press <RETURN> ' to XX
Store 'Q' to XX
else
Store $(cdirindex,2,1) to SPFUND
Store str(wknumb,2) to wkx
endif
?
endif
If !(XX)<>'Q' .and. !(EN)<>'Q'
If MSEL='3'
Accept 'About to delete this record. OK? ' to xx
If !(XX)='Y'
Replace CDIRINDEX with $(CDIRINDEX,1,2)+'|'+$(CDIRINDEX,4,9)
endif
else
Store $(spact,1,11) to XX
Store &XX to NN
?
?
?
?
@ 20,4 say 'Spec.Fund amount' get NN
@ 21,4 say 'Envelope number ' get envl
@ 20,44 say 'Week number ' get wkx
@ 20,72 say $(curdates,wknumb*6-5,5)
@ 21,44 say 'Special Fund ' get SPFUND
READ
? 'Now recording $',NN,' into Special Fund =',$(CDIRINDEX,2,11)
?
Accept ' The old record will be written over. OK? ' to xx
If !(XX)='Y'
Store val(wkx) to wknumb
Replace CDIRINDEX with '$'+SPFUND+'.'+$(curdates,wknumb*6-5,5)+str(envl,4)
Replace spact with str(NN,11,2)
endif
endif
endif
enddo
CASE MSEL='4'
Select secondary
GOTO 51
?
Set raw on
Do while .not. EOF
Do while @($(cdirindex,3,1),'.*')<>0.and. .not. EOF
SKIP
enddo
If .not. EOF
?? ' ',$(cdirindex,2,2),$(spact,1,17)
endif
SKIP
enddo
?
Set raw off
Accept 'End of Special Funds. Press <RETURN> ' to xx
CASE MSEL='5'
?
?
Store ' ' to SF
Do while !(SF)<>'Q'
? ' Current Special Fund letters: ',CSA
?
Accept 'Enter a Special Fund letter to be added ' to SF
Store '$'+$(SF,1,1)+'*' to SFX
Find &SFX
Do while #=0.and.!(SF)<>'Q'
If #=0
Accept 'Invalid Special Fund Designator. Please enter another ' to SF
Store '$'+$(SF,1,1)+'*' to SFX
Find &SFX
endif
enddo
If !(SF)<>'Q'
?
Accept 'Enter a name for this Special Fund ' to SFNAME
Store sfname+' ' to sfname
Store $(sfname,1,22) to sfname
?
? 'Now adding Special Fund [',$(SF,1,1),'] - ',SFNAME
Accept ' OK? ' to XX
If !(XX)='Y'
Replace CDIRINDEX with '$'+$(SF,1,1)+' '+date()
Replace SPACT with SFNAME
Store CSA+$(SF,1,1) to CSA
GOTO 49
Store trim(spact) to tspact
If len(tspact)=39
GOTO 50
Store trim(spact) to tspact
endif
Replace spact with tspact+SF
else
? 'Special Fund is NOT added.'
?
endif
endif
enddo
CASE MSEL='6'
?
?
Store ' ' to SF
Do while !(SF)<>'Q'
? ' Current Special Fund letters: ',CSA
?
Accept 'Select a Special Fund letter to edit ("Q"=quit) ' to SF
Store '$'+$(SF,1,1)+' ' to SFX
Find &SFX
Do while #=0 .and. !(SF)<>'Q'
Accept 'Invalid Special Fund Designator. Please enter another ' to SF
Store '$'+$(SF,1,1)+' ' to SFX
Find &SFX
enddo
If !(SF)<>'Q'
Store $(spact,1,22) to SFNAME
Store 0.00 to SFTOTAL
Store val($(spact,23,9))+sftotal to SFTOTAL
?
?
?
?
@ 21,10 say 'Special Fund Name ' get SFNAME
@ 21,62 say 'FUND:',$(cdirindex,2,11)
@ 22,10 say 'Special Fund Previous Total ' get SFTOTAL
READ
?
? 'Now changing to - ',SFNAME,' $',SFTOTAL
Accept ' OK? ' to XX
If !(XX)='Y'
Replace spact with SFNAME+str(sftotal,9,2)+$(spact,23,9)
endif
endif
enddo
CASE MSEL='7'
?
Store ' ' to SF
Do while !(SF)<>'Q'
? ' Current Special Fund letters: ',CSA
?
Accept 'Select a Special Fund letter to delete ("Q"=quit) ' to SF
Store '$'+$(SF,1,1)+' ' to SFX
Find &SFX
Do while (#=0 .and. !(SF)<>'Q') .or. SF='-'
Accept 'Invalid Special Fund Designator. Please enter another ' to SF
Store '$'+$(SF,1,1)+' ' to SFX
Find &SFX
enddo
If !(SF)<>'Q'
?
? 'About to delete Special Fund = [',$(cdirindex,2,1),'] ',$(spact,1,22)
? 'This will cancel the Fund name and all individual contributions under it.'
Accept ' OK? ' to XX
If !(XX)='Y'
Replace cdirindex with $(SFX,1,2)+'* '+date()
SKIP
Store $(SFX,1,2)+'.' to SFX
Do while cdirindex=SFX
? 'CANCELED:',$(cdirindex,4,9),spact
Replace CDIRINDEX with $(SFX,1,2)+'|'
SKIP
enddo
GOTO 49
Store F to THERE
If @($(SFX,2,1),spact)<>0
Store T to THERE
else
SKIP
If @($(SFX,2,1),spact)<>0
Store T to THERE
endif
endif
If THERE
Store @($(SFX,2,1),spact) to N
Replace spact with $(spact,1,N-1)+$(spact,N+1,40-N)
endif
endif
endif
? 'This Special Fund is now cancelled.'
?
?
enddo
CASE MSEL='9'
Store '$-' to SFUNDS
Find &SFUNDS
If #<>0
? ' CONTRIBUTIONS Special Funds Totals ',curdate
?
? ' Previous New Full'
? ' LAST DATE FUND Special Fund Name Total Total Total'
? ' TOTALED LETTER Amount Amount Amount'
? ' -------- ------ --------------------- -------- ------- -------'
Do while .not. EOF
If $(cdirindex,3,1)=' '
Store 0.00 to sfnd
Store sfnd+val($(spact,23,9))+val($(spact,32,9)) to sfnd
? $(cdirindex,4,9),' [',$(cdirindex,2,1),'] ',$(spact,1,22),' '
?? $(spact,23,19),str(sfnd,9,2)
endif
SKIP
enddo
?
Accept 'End of totals. Press <RETURN> ' to XX
else
Accept 'No Special Funds found. Press <RETURN> ' to xx
endif
CASE MSEL='8'
Store ' ' to SF
Do while SF<>'Q'
Accept 'Enter a Special Fund letter (Press <RETURN> for all) ' to SF
?
If !(SF)<>'Q'
If SF<>' '
Store '$'+SF+' ' to SF
Find &SF
If #<>0
? ' NOW TOTALING [',$(cdirindex,2,1),'] ',$(spact,1,22)
Store $(SF,1,2)+'.' to SFF
Store str(#,4) to SFNUMB
SKIP
Store $(CDIRINDEX,1,2) to SFX
Store 0.00 to SFAMOUNT
Do while SFF=SFX
Store SFAMOUNT+val($(spact,1,11)) to SFAMOUNT
? ' ',cdirindex,$(spact,1,11)
SKIP
Store $(CDIRINDEX,1,3) to SFX
enddo
GOTO &SFNUMB
? ' --------'
? ' TOTAL $',str(sfamount,11,2),' [',$(cdirindex,2,1),'] '
?? $(spact,1,22)
Replace cdirindex with $(CDIRINDEX,1,4)+date()
Replace spact with $(spact,1,31)+str(SFAMOUNT,9,2)
?
else
Accept 'Special Fund not found. Press <RETURN> ' to xx
endif
else
Store '$-' to SF
Find &SF
If #<>0
Do while .not. EOF
?
? 'Contributions Special Fund TOTAL [',$(cdirindex,2,1),']',$(spact,1,22)
Store $(cdirindex,1,2)+'.' to SFF
Store str(#,4) to SFNUMB
SKIP
Store $(CDIRINDEX,1,3) to SFX
Store 0.00 to SFAMOUNT
Do while SFF=SFX
Store SFAMOUNT+val($(spact,1,11)) to SFAMOUNT
? ' ',cdirindex,$(spact,1,11)
SKIP
Store $(CDIRINDEX,1,3) to SFX
enddo
Store str(#,4) to SFNUMBX
GOTO &SFNUMB
? ' --------'
? ' TOTAL $',str(sfamount,11,2),' [',$(cdirindex,2,1),']'
?? $(spact,1,22)
?
?
Replace cdirindex with $(CDIRINDEX,1,4)+date()
Replace spact with $(spact,1,31)+str(SFAMOUNT,9,2)
GOTO &SFNUMBX
Do while $(cdirindex,3,1)<>' ' .and. .not. EOF
SKIP
enddo
enddo
endif
endif
endif
Accept 'Totals are complete. Press <RETURN> ' to xx
Store 'Q' to SF
endif
enddo
endif
CASE MSEL<>'Q'
Accept 'These routines are not written, yet. ' to xx
endcase
endif
enddo
Select secondary
Use
Select primary
Release LEVEL3,NN,EN,WKNUMB,ENVL,SFFUND,SFNUBM,WKX,SPFUND,SFNAME,TSPACT,SFND,SF
Release SFX,SFTOTAL,THERE,SFUNDS,SFND,SFF,SFAMOUNT,SFNUMBX
RETURN
ete Special Fund = [',$(cdirindex,2,1),'] ',$(spact,1,22)
? 'This will cancel the Fund name and all individual contributions under it.'
Accept ' OK? ' to XX
If !(XX)='Y'
Replace cdirindex with $(SFX,1,2)+'* '+date()
SKIP
Store $(SFX,1,2)+'.' to SFX
Do while cdirindex=SFX
?