Shareware Overload/ShartewareOverload.cdr/database/chrchpr3.zip/CFBUDGDE.CMD

OS/2 REXX Batch file | 1991-01-21 | 7KB | 285 lines

* Program CFBUDGDE - View/edit a particular church department budget
Select secondary
Use workshet
Select primary
If len(NSEL)>1
  Store $(NSEL,2,1) to indept
else
  Accept 'Enter a Department Number ' to INDEPT
endif
Store T to inval2
Do while inval2
  If indept=' ' .or. !(INDEPT)='Q'
    RETURN
  endif
  Store 'D'+$(INDEPT,1,1) to INDFIND
  Find &INDFIND
  If # = 0
    Accept 'Department number not found. Enter again ' to INDEPT
  else
    Store F to inval2
  endif
ENDDO
Release NSEL,INVAL1,indept
Store $(account,4,30) to deptname
?
? 'Now reading the Account entries for Department:',deptname
Store # to INDX
Store ' ' to OSEL
Store '0' to N
Do while !(OSEL)<>'Q'
Select primary
Find &INDFIND
SKIP
Store 'A' to OSEL
Store 64 to I
Store 0.00 to acctytd
Store 0.00 to accntpo
Store 0.00 to accntbal
Store 0.00 to no
Store 0.00 to tp
Do while .not. EOF .and. account=INDFIND .and. I<79
  Store I+1 to I
  Store chr(I) to N
  Store val(paidytd)+acctytd to acctytd
  Store $(account,3,29)+paidytd+' '+str(prevowed,9,2) to accname&N
  Store prevowed+accntpo to accntpo
  Replace NO&N with newowed
  Store newowed+no to no
  Replace TP&N with newpaid
  Store newpaid+tp to tp
  Store pp to PP&N
  SKIP
enddo
Set colon off
SKIP -1
Store $(account,3,1) to NN
If I=64
  Store '@' to NN
endif
Store I to II
Do while !(OSEL)='R'.or.!(OSEL)='O'.or.!(OSEL)='P'.or.!(OSEL)='A'
ERASE
@ 0,1 say MFILE
@ 0,62 say curdate
@ 1,4 say CHNAME+' Monthly Budget for : '+deptname
If !(OSEL)='O'
  @ 2,51 say '*******'
endif
If !(OSEL)='P'
  @ 2,61 say '******* *'
endif
@ 3,9  say 'Account           year-to-date  previous     new      to be '
@ 3,74 say 'owed'
@ 4,18 say '              actual     owed      owed       paid     balance'
Store 64 to I
If II=64
  @ 5,25 say '**** NO ACCOUNTS IN THIS DEPARTMENT ****'
else
 Store 0.00 to accntbal
 Do while I < II
  Store I+1 to I
  Store chr(I) to N
  @ I-59,0 say accname&N
  Store val($(accname&N,39,9))+NO&N-TP&N to BAL
  @ I-59,69 say PP&N
  If !(OSEL)='O'
    @ I-59,50 get NO&N
  else
    @ I-59,50 say NO&N
  endif
  If !(OSEL)='P' .and. PP&N<>'*'
    @ I-59,60 get TP&N
    @ I-59,69 get PP&N
  else
    @ I-59,60 say TP&N
    @ I-59,69 say PP&N
  endif
  @ I-59,70 say BAL
  Store accntbal+BAL to accntbal
 enddo
endif
@ I-58,23 say '^      --------   -------   -------   -------     -------'
READ
GOTO 1
If OSEL<>' '
  Store 64  to J
  Store 0.00 to TP
  Store 0.00 to NO
  Store 0.00 to accntbal
  Do while J < II .and. !(OSEL)<>' '
    Store J+1 to J
    Store chr(J) to N
    Store tp+tp&N to TP
    Store NO+NO&N to NO
    Store val($(accname&N,39,8))+NO&N-TP&N to BAL
    @ J-59,70 say BAL
    Store accntbal+bal to accntbal
  enddo
 endif
 @ I-57,28 say acctytd
 @ I-57,38 say accntpo
 @ I-57,48 say no
 @ I-57,58 say tp
 @ I-57,70 say accntbal
 ?      'Select  [O]wed editing    [A]dd a new account        [R]eport'
 Accept '        [P]aid editing    [D]elete existing account  [Q]uit  ' to OSEL
 Store T to inval2
 Do while inval2
  Store F to inval2
  Do case
  CASE !(OSEL)='O'
    Store F to inval2
  CASE !(OSEL)='P'
    Store F to inval2
  CASE !(OSEL)='A'
    Store 'Y' to XX
    Do while !(XX)='Y'
      * ACCOUNT lettering can range from "A" to "Y"
      * Deleted account letters are not-re-used.
      If II=79 .or. NN='Y'
 ? 'Illegal ADD - 15 accounts allowed, maximum. Highest account letter = "Y".'
        Store ' ' to XX
      else
      Release BAL,OSEL
      Store II+1 to I
      Store I to II
      Store chr(I) to N
      Clear gets
      Set colon on
      Store 0.00 to TP
      Store 0.00 to NO
      Store '                        '  to XX
      Store '                         ' to AD1
      Store '                         ' to AD2
      If I<76
        @ I-53,0 say 'ACCOUNT name' get XX
        @ I-53,43 say 'payment' get TP
        @ I-53,64 say 'owed' get NO
        @ I-52,0 say 'ADDRESS' get AD1
        @ I-52,32 say '  ^  CITY,STATE ZIP' get AD2
      else
        @ 22,0 say 'ACCOUNT name' get XX
        @ 22,43 say 'payment' get TP
        @ 22,64 say 'owed' get NO
        @ 23,0 say 'ADDRESS' get AD1
        @ 23,32 say '  ^  CITY,STATE ZIP' get AD2
      endif
      READ
      Store len(trim(XX)) to J
      Set colon off
      Select primary
      If XX<>'    '
      Append blank
      Store chr(rank(NN)+1) to NN
      Replace account with indfind+NN+' '+XX
      If TP<>0.00
        Store 'P' to PP&N
      else
        Store ' ' to PP&N
      endif
      Replace newpaid with 0.00
      Replace newowed with 0.00
      Replace paidytd with '     0.00'
      Store $(account,3,29)+paidytd+' '+str(prevowed,8,2) to accname&N
      Select secondary
      Replace TP&N with tp
      Replace NO&N with NO
      else
       ? 'No account name entered. No account was added.'
       Store II-1 to II
      endif
      Accept 'Add another ACCOUNT? ' to XX
      Release AD1,AD2
     endif
    ENDDO
    Store 'A' to OSEL
  CASE !(OSEL)='D'
    Select primary
    Store 'Y' to N
    ? 'WARNING: This routine causes any amount updates to be forgotten.'
    Do while !(N)='Y'
    Accept 'Enter account to be deleted ' to N
    Store INDFIND+N  to XX
    Find &XX
    If #=0
      ? 'This account letter is not found.'
    else
     If val(paidytd)= 0 .and. (PP<>'*' .or. newpaid=0)
      ? account,'has been deleted.'
      Replace account with 'E'+$(account,2,33)
      Release accname&N,PP&N
     else
      ? 'This account has previous amounts paid. It is not valid to delete it.'
     endif
    endif
    Accept 'Delete another? ' to N
    enddo
    Select secondary
  CASE !(OSEL)='R'
    Set format to print
@ 1,3 say MFILE
@ 1,60 say curdate
@ 2,8  say CHNAME+' Monthly Budget - for : '+deptname
@ 4,9  say 'Account                 paid    previous     new      to be '
@ 5,18 say '             this yr     owed       owed      paid    Balance'
Store 64 to I
Do while I<>II
  STORE I+1 TO I
  Store CHR(I) to N
  @ I-58,0 say accname&N
  Store val($(accname&N,39,8))+NO&N-TP&N to BAL
  @ I-58,50 say NO&N
  @ I-58,60 say TP&N
  @ I-58,69 say PP&N
  @ I-58,71 say str(BAL,8,2)
enddo
@ I-57,30 say '--------   -------   -------   -------    -------'
@ I-56,28 say acctytd
@ I-56,38 say accntpo
@ I-56,48 say no
@ I-56,58 say tp
@ I-56,69 say accntbal
    EJECT
    Set format to screen
  CASE !(OSEL)='Q'
    Release NN,bal,accntbal,acctytd
    Store F to inval2
    Store 64  to I
    Select primary
    GOTO INDX
    SKIP
    Store 0.00 to NN
    Store 0.00 to NO
    Do while I<II
     Store I+1 to I
     Store chr(I) to N
     Replace newowed with S.NO&N
     Replace newpaid with S.TP&N
     If PP&N='*'.and.PP<>'*'
       Store ' ' to PP&N
     endif
     If PP&N='*'
       Store NO+newpaid to NO
     else
       Store NN+newpaid to NN
       Replace pp with PP&N
     endif
     Release PP&N,accname&N
     SKIP
    enddo
    GOTO INDX
    Replace newpaid with NN
    Replace newowed with NO
    Release inval2,no,accntpo,tp,INDFIND,J,I,N,II,NN,deptname,XX,osel,indx
    Store 'D' to nsel
    RETURN
  otherwise
    Store T to inval2
    Accept 'Invalid entry. Please enter again ' to OSEL
  ENDCASE
ENDDO
ENDDO
ENDDO
RETURN