home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr3.zip
/
CFBRECVD.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1991-01-21
|
6KB
|
191 lines
* Program CFBRECVD - Accepts Received amounts for the ACCOUNTS file.
* ACCTREC&N = string of individual receivables for each department.
* DEPTCUR&N = the total of each element in ACCTREC&N
* N = Department code MM = receivables sequence numbers
Use
Select primary
Store d+':ACCOUNT'+DF to mfile
Use &MFILE index &MFILE
Store '0' to N
Find D1
If #=0
? 'ACCOUNTS file is missing the "D1" Department. '
Accept 'The file must be re-created. Press <retn> to exit' to XX
RETURN
endif
? 'Now reading the Receivables amounts from the ACCOUNTS file.'
Store ' ' to DEPTNAMS
Store ' ' to deptrecs
Store ' ' to deptytd
Store ' ' to M
Store ' ' to IN
Do while .not. EOF .and. N<>'9' .and. account='D'
Store str(val(N)+1,1) to N
Store $(account,1,2) to inaccnt
Store DEPTNAMS+$(account,2,25) to DEPTNAMS
Store deptrecs+str(#,5) to deptrecs
Store ' ' to acctrec&N
Store # to I
Store $(inaccnt,2,1) to indept
Store M+$(account,2,1) to M
Store 'R'+indept to inrecv
Find &INRECV
If #=0
? 'Now appending a Receivables record for: ',$(deptnams,val(N)*25-23,23)
APPEND BLANK
Replace ACCOUNT with inrecv
Store deptytd+' 0.00 0.00' to deptytd
Store 0.00 to newpaid
Store ' 0.00' to deptcur&N
Store str(#,5) to acctdat&N
else
Store deptytd+paidytd+str(prevowed,8,2) to deptytd
Store str(#,5) to acctdat&N
SKIP
Store 0 to II
Do while account=inrecv .and. len(acctdat&N)<40 .and..not.EOF
Store acctrec&N+str(newpaid,8,2)+'-'+$(newpdate,4,2) to acctrec&N
Store II+newpaid to II
Store acctdat&N+str(#,5) to acctdat&N
Store $(account,3,1) to IN
SKIP
enddo
Store ' '+IN+acctdat&N to acctdat&N
Store str(II,8,2) to deptcur&N
endif
GOTO I
Do while account=inaccnt .and. .not. EOF
SKIP
enddo
enddo
Store N to IN
Store '0' to N
Store ' ' to ESEL
Store len(M)-1 to II
Store $(M,2,II) to MM
Do while ESEL<>'Q'
Store '0' to N
Erase
@ 0,1 say MFILE
@ 0,27 say 'ACCOUNTS RECEIVABLES '+curdate
Do while N<>IN
Store val(N)+1 to I
Store str(I,1) to N
@ I*2,0 say $(deptnams,I*25-24,25)
@ I*2,26 say 'Prev.YTD:'+$(deptytd,I*17-15,17)+' Curr.month: $'+deptcur&N
@ I*2+1,1 say acctrec&N
enddo
?
? 'Select - [A]dd amount [R]eport '
Accept ' [C]hange Amount [Q]uit ' to ESEL
?
Store T to inval1
Do while inval1
Store F to inval1
Do case
CASE !(ESEL)='A'
If len(esel)>1
Store $(esel,2,1) to xx
else
Accept ' Enter Department number' to XX
endif
Store $(xx,1,1) to M
If @(M,MM) = 0
Accept 'Invalid Department. Press <retn>' to xx
else
Store @(M,MM) to I
Store str(I,1) to N
Store (len(acctrec&N)-1)/11 to II
If II > 6
Accept 'Too many receivables in this Dept. Max is 7. Press <RETN>' to XX
else
Append blank
@ 20,0 say ' Enter RECEIVED amount - $' get NEWPAID
READ
Store acctrec&N+str(newpaid,8,2)+'-'+$(date(),4,2) to acctrec&N
Store '>'+$(acctdat&N,2,len(acctdat&N)-1)+str(#,5) to acctdat&N
Store str(newpaid+val(deptcur&N),8,2) to deptcur&N
Replace newpdate with date()
Replace account with 'R'+N+str(val($(acctdat&N,2,1))+1,1)
endif
endif
CASE !(ESEL)='C'
If len(esel) > 1
Store $(esel,2,1) to xx
else
Accept 'Enter Department number' to XX
endif
Store $(xx,1,1) to M
Store @(M,MM) to I
If I=0
Accept 'Invalid Department. Press <RETURN>' to xx
else
Store str(I,1) to N
Accept 'Enter sequence number to edit' to xx
Store val(xx) to I
Store len(acctrec&N) to ILEN
If I < 1.or.I > (ILEN-1)/11
Accept 'Invalid sequence number. Press <RETURN>' to xx
else
Store val($(acctdat&N,I*5+3,5)) to II
GOTO II
Store val($(acctrec&N,I*11-9,8)) to II
Set raw on
@ 20,0 say 'Enter new RECEIVED amount - $' get newpaid
READ
Set raw off
If (ILEN-1)/11=I
Store $(acctrec&N,1,I*11-10)+str(newpaid,8,2)+'-'+$(date(),4,2) to acctrec&N
else
Store $(acctrec&N,1,I*11-10)+str(newpaid,8,2)+'-'+$(date(),4,2)+;
$(acctrec&N,I*11+2,ILEN) to acctrec&N
endif
Store str(val(deptcur&N)+newpaid-II,8,2) to deptcur&N
Store '>'+$(acctdat&N,2,len(acctdat&N)-1) to acctdat&N
endif
endif
CASE !(ESEL)='R'
Store '0' to N
Set format to print
@ 0,1 say MFILE
@ 0,27 say 'ACCOUNTS RECEIVABLES '+curdate
Do while N<>IN
Store val(N)+1 to I
Store str(I,1) to N
@ I*2,0 say $(deptnams,I*25-23,25)
@ I*2,26 say 'Prev.YTD:'+$(deptytd,I*17-15,17)+' Curr.month: $'+deptcur&N
@ I*2+1,1 say acctrec&N
enddo
Eject
set format to screen
CASE !(ESEL)='Q'
Store 'Q' to ESEL
Store '0' to N
Do while N<>IN
Store str(val(N)+1,1) to N
If $(acctdat&N,1,1)<>' '
Store val($(acctdat&N,3,5)) to II
GOTO II
Store val(deptcur&N) to I
Replace newpaid with I
Store I+prevowed to I
Store val($(deptrecs,val(N)*5,5)) to II
GOTO II
Replace newpdate with str(I,8,2)
endif
enddo
otherwise
Accept 'Invalid entry. Please enter again' to ESEL
Store T to invaldd
endcase
enddo
enddo
Release ESEL,deptnams,deptrecs,deptytd,m,mm,in,inval1,indept,inrecv,ii,ilen
Store '0' to N
Do while N<>'9'
Store str(val(N)+1,1) to N
Release DEPTCUR&N,ACCTREC&N,ACCTDAT&N
enddo
Use
RETURN