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

OS/2 REXX Batch file | 1991-01-21 | 18KB | 571 lines

* Program MCANALYS - gives statistical reports of contributions amounts/totals
Select secondary
Use CDIRFILE index CDIRFILE
GOTO 17
Store $(spact,34,1) to OP
Store T to LEVEL3
Do while LEVEL3
Erase
@ 1,1 say 'DATA DISK = '+D
@ 1,62 say curdate
@ 3,15 say 'CONTRIBUTIONS Statistical Analysis and Reports'
?
? '      1)  Pledged/Given Report - from MEMBERS file'
? '      2)  Pledged/Given Report - from special MEMBCON file'
? '      3)  Compute and display statistics totals from MEMBERS file'
? '      4)  Compute and display statistics totals from special MEMBCON file'
? '      5)  Edit seasonal adjustment monthly factors'
? '      6)  Create a secondary MEMBCON file by contribution amount'
?
Accept '         Enter selection '  to OSEL
Do while @(osel,'123456Qq')=0
  Accept 'Invalid entry. Please enter again ' to OSEL
enddo
If !(OSEL)='Q'
  Store F to LEVEL3
else
Do CASE
  CASE OSEL='1'.or.OSEL='2'
    If osel='1'
      Store D+':MEMBERS' to MFILE
    else
      Store D+':MEMBCON' to MFILE
    endif
    If .not.file(MFILE)
      ? MFILE,'file is not found.'
      Accept '          Press <RETURN> ' to xx
      Store '9' to osel
    else
      Select secondary
      Use &MFILE index &MFILE
      Select primary
?
? 'This process uses the',MFILE,'file and the CONTRIB file data. All MEMBERS'
? 'with offering envelopes have their pledged amount compared with their given'
? "to-date for the assigned pledged category.  Today's month number is used to"
? 'pro-rate the amount expected by this date in the year.  For example, for '
? 'the month of July (end of June), the "expected" amount would be half of the'
? 'pledged-for-the-year amount.  Totals from the previous month are used -'
? 'the program ignores amounts given so far in the current month.  Seasonal'
? 'adjustment totals are made to these figures after first reporting the'
? 'straight totals.  Names with an equal sign (=) in front of them are'
? 'married, the name of their spouse is not shown.'
? 'NOTE: If you indicate the TOTALS category as designated for PLEDGED, (one'
? 'number higher than your last category), you will get a report of TOTALS'
? 'amounts.  Otherwise, this report is for one category, only.'
?
 ? 'Now setting up the CONTRIB file for statistics. Ready the printer.'
      Set talk on
      Replace all MCONSTATUS with ' '+$(mconstatus,2,4)
      Set talk off
      Select secondary
      Store val($(date(),1,2))-1 to cmonth
      Store T to beginng
      Store 0.00 to OCAT
      Store 0.00 to ocatp
      Store 0.0 to ocate
      Store 0 to page
      Store 99 to ln
      Store '                    ' to spaces
      Set format to print
      Store trim(chname) to cname
      If len(cname)<17
        Store '          '+chname to cname
      endif
      Do while .not. EOF
        If .not. BEGINNG
          If ln>60
            If page>0
              EJECT
            endif
            Store page+1 to page
@ 1,0 say cname+' Contributions Analysis -- '+curdate+'  Page'+str(page,3)
@ 3,0 say 'ENVEL'
@ 3,13 say 'NAME               phone     pledged    given   expected    amount'
@ 4,0 say 'NUMB.'
@ 4,52 say                                        'to-date   to-date    behind'
            Store 5 to ln
          endif
          Store ' ' to mb
          If $(familycode,9,1)='M'
            Store '=' to mb
          endif
          Store 0.00 to ocatexpect
          Store val(pledged)*cmonth/12 to ocatexpect
          Store ocatexpect+ocate to ocate
          Store ocatexpect-val($(ocateg&OP,1,9)) to obehind
          @ ln,0 say offer+' '+$(s.ss:sc:memb,1,4)+names
@ ln,40 say pledged+' '+$(ocateg&OP,1,9)+str(ocatexpect,10,2)+str(obehind,10,2)
          Store ocatp+val(pledged) to ocatp
          Store ocat+val($(ocateg&OP,1,9)) to ocat
          SKIP
          Store ln+1 to ln
        endif
        Store F to beginng
        Store '.' to mcstat
Do while (offeringen<1 .or.offeringen>offermax.or.mcstat='.') .and. .not. EOF
          If offeringen<1 .or.offeringen>offermax
            SKIP
          else
            Store str(offeringen,4) to OFFER
            Select primary
            GOTO &OFFER
            If mconstatus='.'
             Select secondary
             SKIP
            else
              Replace mconstatus with '.'+$(mconstatus,2,4)
              Select secondary
              Store ' ' to mcstat
              Store ' ' to mb
              If $(familycode,9,1)='M'
                Store '=' to mb
              endif
              Store mb+trim(last:name)+', '+trim(first:name) to names
              Store len(names) to lennames
              If lennames>20
                Store $(names,1,20)+'_'+home:phone to names
              else
                Store names+$(spaces,1,21-lennames)+home:phone to names
              endif
            endif
          endif
          Select secondary
        enddo
    enddo
     Store '---------------------------------------' to xx
     @ ln,1 say xx+xx
@ ln+1,9 say 'TOTALS                        '+str(ocatp,10,2)
@ ln+1,50 say str(ocat,9,2)+str(ocate,10,2)+str(ocate-ocat,10,2)
Select secondary
Use cdirfile index cdirfile
GOTO 19
Store 0 to wght
Store 3 to O
Store 0 to cmon
Do while #<21
  Store val($(spact,O,3))+wght to wght
  Store cmon+1 to cmon
  If cmon<=cmonth
    Store wght to cwght
  endif
  Store O+7 to O
  If O>40
    SKIP
    Store 3 to O
  endif
enddo
Store ocatp*cwght/wght to O
@ ln+2,9 say 'SEASONALLY ADJUSTED TOTALS '
@ ln+2,60 say str(O,9,2)+str(o-ocat,10,2)
    Eject
    Set format to screen
    ?
    Accept 'Report is complete. Press <RETURN> ' to xx
    Release cmonth,beginng,ocat,ocatp,ocate,ln,spaces,mcstat,cname,offer,names
  Release mb,lennames,ocatexpect,obehind,O,cwght,wght,catnumb,page,cmon,distrib
  CASE OSEL='3'.or.OSEL='4'
    If osel='3'
      Store D+':MEMBERS' to MFILEM
    else
      Store D+':MEMBCON' to MFILEM
    endif
    Store D+':CONTRIB' to MFILE
?
? 'This process prints a statistical report of member giving, by contribution'
? 'amount.  You select the contribution category, and the low and high amounts'
? 'for the report.  The program determines 50 evenly spaced contribution'
?? 'amount'
? 'increments.  Contributions are for all completed months so far this year.'
? 'The report will show the number of people who have given in each'
? 'increment - helping you to see how many people there are that give little,'
? 'versus how many larger givers there are.  You are to specify a low amount'
? 'that the report will start at, and a high amount that it will end at.  All'
? 'people below or above this amount are lumped together outside of the graph.'
? '  Example:  Enter low amount :  100.00 '
? '            Enter high amount: 2600.00                            ',MFILEM
? '                                             14'
? '                             12        12 '
? '             10      10  10    1010  10  10    10  '
? '         8       8     8           8       8       8 8     8  '
? '     6 6       6   6                             6     6 6     6  '
? '   4       4                                                 4       '
? '___________________________________________________________________________'
? ' 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1...'
? ' 5 0 5 0 5 0 5 0 5 0 5 0 5 0 5 0 5 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9...'
? ' 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 0 5 0 5 0 5 0 5 0 5 0 5 0 5 0 5 0...'
? '                                   0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0...'
? 'Now setting up CONTRIB file.'
Select primary
Use &MFILE
Replace all mconstatus with ' '+$(mconstatus,2,4)
If OSEL='4'
  Select secondary
  Use &MFILEM
  Replace all MCONSTATUS with '.'+$(mconstatus,2,4)
  Use &MFILEM
  Index on offeringen to &MFILE
  Use &MFILEM index &MFILE
  Find 1
  If #=0
  Find 2
  If #=0
  Find 3
  If #=0
    GOTO TOP
    ? 'Now searching for first offering envelope.'
    Do while offeringen=0 .and. .not. EOF
      SKIP
    enddo
  endif
  endif
  endif
  ? 'Now marking significant CONTRIB file records.'
  Store 0 to rec
  Store 0 to recc
  Do while .not. EOF
    Store offeringen to N
    If N<=offermax
      Select primary
      GOTO N
      Replace MCONSTATUS with ' '+$(mconstatus,2,4)
      Select secondary
    endif
    SKIP
    Store rec+1 to rec
    If rec=100
      Store recc+100 to recc
      ? recc,'RECORDS PROCESSED'
      Store 0 to rec
    endif
  enddo
endif
Release rec,recc,MFILEM
Accept 'Enter low amount  ' to XX
Store val(XX) to lamount
Accept 'Enter high amount ' to XX
Store val(XX) to hamount
If hamount-lamount<200
  Store lamount+200 to hamount
  ? 'High amount is not $200 or more above low amount. Changed to $',hamount
endif
Store (hamount-lamount)/50 to increamt
Store lamount+(50*increamt) to hamount
?
? '  Offering category numbers -      0 - PLEDGED        1 -',OCATNAM1
Store '1' to N
?
Do while N<>OT
  Store str(val(N)+1,1) to N
  ?? '   ',N,'-',OCATNAM&N
enddo
Accept 'Enter a category number ' to xx
Do while @(xx,'012345Qq')=0.or.val(xx)>val(OT)
  Accept 'Invalid entry. Please enter again ' to xx
enddo
Select primary
GOTO TOP
If XX='0'
  Store "PLEDGED" to OCATEG
  Store "PLEDGED" to ocatnam
else
  Store "$(OCATEG&XX,1,9)" to OCATEG
  Store ocatnam&XX to ocatnam
endif
Store "val(&OCATEG)>LN.and.val(&OCATEG)<=HN" to selct
Store '9' to N
Select secondary
Use CDISTRIB
Do while N<>'41'
  Replace DISTRIB&N with 0
  Store str(val(N)+1,2) to N
enddo
Do while N<>'62'
  Store 0 to DISTRIB&N
  Store str(val(N)+1,2) to N
enddo
If !(xx)<>'Q'
  Store lamount to LN
  Store lamount+increamt to HN
  Select primary
  Store 0 to rec
  Store 0 to recc
? ' Now computing the Distribution Statistics for contributions.'
  Store T to beginng
  Do while .not. EOF
    If .not. BEGINNG
    Store val(&OCATEG) to VALOCAT
    IF VALOCAT=0
      Store '9' to INX
      Replace DISTRIB9 with DISTRIB9+1
    else
    If val(&OCATEG)<=lamount
      Store '10' to INX
      Replace DISTRIB10 with DISTRIB10+1
    else
      Store lamount to LN
      Store lamount+increamt to HN
      Do while HN<=hamount .and. .not.(&selct)
        Store hn to ln
        Store ln+increamt to hn
      enddo
      Select secondary
      If HN>hamount
        Store DISTRIB61+1 to DISTRIB61
        Store '61' to INX
      else
        Store str((hn-lamount)/increamt+10,2) to INX
        If val(INX)>40
          Store DISTRIB&INX+1 to DISTRIB&INX
        else
          Replace DISTRIB&INX with DISTRIB&INX+1
        endif
      endif
    endif
    endif
    Select primary
    Replace mconstatus with '.'+$(mconstatus,2,4)
    SKIP
   endif
   Store F to beginng
   Do while mconstatus='.'.and. .not. EOF
     SKIP
   enddo
   Store rec+1 to rec
   If rec=20
      Store recc+20 to recc
      ? recc,'RECORDS PROCESSED'
      Store 0 to rec
   endif
  enddo
  ? '      0 -',DISTRIB9
  Store '9' to N
  Store lamount to ln
  Store 0 to md
  Do while N<>'60'
    Store str(val(N)+1,2) to N
    Store str(distrib&N,4) to distrib
    ?? LN,' -',distrib
    If distrib&N > md
      Store distrib&N to md
    endif
    Store LN+increamt to LN
  enddo
  ? str(hamount,8,2),'+  -',str(distrib61,4)
  ?
  Accept 'Ready the printer, or press <ESC> to exit ' to XX
  Store md/10 to md
  Set format to print
  @ 1,62 say curdate
  @ 2,1 say chname+'    Contributions Distribution Statistics  --  '+ocatnam
  @ 4,0 say 'CONTRIB        Number of Contribution Givers for these Amounts'
  @ 5,0 say 'AMOUNT '
  @ 6,1 say '  0 | '+str(distrib9,4)
  @ 7,0 say '<'+str(lamount+increamt,3)+' | '+str(distrib10,4)
  @ 8,0 say ;
'============================================================================='
  Store '10' to N
  Store lamount to HN
  Do while N<>'60'
    Store VAL(N)+1 to LN
    Store str(LN,2) to N
    Store distrib&N*7/md to CN
    Store HN+increamt to HN
    @ LN-2,0 say str(HN,4)+' |'
    @ LN-2,CN+6 say str(distrib&N,3)
  enddo
  @ 59,0 say ;
'-----------------------------------------------------------------------------'
  @ 60,0 say '>'+str(hamount,4)+'|'+str(distrib61,5)
  EJECT
  Set format to screen
  Release DISTRIB41,DISTRIB42,DISTRIB43,DISTRIB44,DISTRIB44,DISTRIB45,DISTRIB46
  RELEASE DISTRIB47,DISTRIB48,DISTRIB49,DISTRIB50,DISTRIB51,DISTRIB52,DISTRIB53
  RELEASE DISTRIB54,DISTRIB55,DISTRIB56,DISTRIB57,DISTRIB58,DISTRIB59,DISTRIB60
  RELEASE HN,LN,CN,DISTRIB61,MD,LAMOUNT,HAMOUNT,OCATNAM,INCREAMT,INX,VALOCAT
  RELEASE SELCT,DISTRIB,OFF,BEGINNG,OCATEG,REC,RECC
    endif
    ?
    Accept 'Report is complete. Press <RETURN> ' to xx
  CASE OSEL='5'
    SELECT SECONDARY
    Set bell off
    Use CDIRFILE index CDIRFILE
?
? '                  SEASONAL ADJUSTMENT MONTHLY FACTORS             '
?
? 'The following are two-digit factor numbers that when used with the'
?? '"STATISTICS'
? 'TOTALS" report give weighted expected contribution amounts by the current'
?? 'month'
?? 'month of the year.  Numbers that are all equal means you expect an equal'
?? 'amount of offerings for each of the 12 months, which is not likely.  So'
?? 'you may want'
? 'to edit these numbers in order to give proper expected offering amounts,'
?? 'per'
? "your church's history."
?
?
?
?
?
?
?
?
Select secondary
Use cdirfile index cdirfile
GOTO 19
Store $(spact,3,3) to  wgt1
Store $(spact,10,3) to wgt2
Store $(spact,17,3) to wgt3
Store $(spact,24,3) to wgt4
Store $(spact,31,3) to wgt5
Store $(spact,38,3) to wgt6
SKIP
Store $(spact,3,3)  to wgt7
Store $(spact,10,3) to wgt8
Store $(spact,17,3) to wgt9
Store $(spact,24,3) to wg10
Store $(spact,31,3) to wg11
Store $(spact,38,3) to wg12
@ 17,4 say ;
'Month   weight      Month   weight      Month   weight      Month   weight'
@ 18,4  say 'January  ' get wgt1
@ 19,4  say 'February ' get wgt2
@ 20,4  say 'March    ' get wgt3
@ 18,24 say 'April    ' get wgt4
@ 19,24 say 'May      ' get wgt5
@ 20,24 say 'June     ' get wgt6
@ 18,44 say 'July     ' get wgt7
@ 19,44 say 'August   ' get wgt8
@ 20,44 say 'September' get wgt9
@ 18,64 say 'October  ' get wg10
@ 19,64 say 'November ' get wg11
@ 20,64 say 'December ' get wg12
READ
Accept '                                                  SAVE? ' to XX
If !(XX)='Y'
  SKIP -1
 Replace spact with '1-'+wgt1+'  2-'+wgt2+'  3-'+wgt3+'  4-'+wgt4+'  5-'+wgt5+;
'  6-'+wgt6
  SKIP
  Replace spact with '7-'+wgt7+'  8-'+wgt8+'  9-'+wgt9+' 10-'+wg10+;
' 11-'+wg11+' 12-'+wg12
endif
?
Use
Release wgt1,wgt2,wgt3,wgt4,wgt5,wgt6,wgt7,wgt8,wgt9,wg10,wg11,wg12
Accept 'Editing is complete. Press <RETURN> ' to xx
Set bell on
    CASE OSEL='6'
?
? 'This process causes creation of a file named MEMBCON from the MEMBERS file,'
?? 'or'
? 'from any Special File of MPROFILE. It is created by a user-selected'
?? 'contribution criteria -'
?? 'by the conditions of the values in a selected contributions category'
?? 'From this file of selected MEMBER records you can make any of the MPROFILE'
? '"Special Reports" (mailing labels, one-line report, ...), or you can'
?? 'perform'
? 'contribution statistics reports.'
? '    Examples:    "TOTALS"<1000.00     "PLEDGED"<500.00     "LOCAL">235.40 '
? 'First enter the number associated with the field you want a selection'
?? 'against,'
? 'then enter the relationship ( <, or >, or = ) and the amount of comparison.'
? '   Example -    Enter category  number :1'
? '                Enter relation, amount :> 1000.00 '
? 'This will select offering category 1 (',OCATNAM1,'), then specifies all'
? 'contributors who have given more than $1000.00 (to',OCATNAM1,'this year.)'
? 'Below are the names of the CONTRIB categories and field names you may'
? 'select from.  Then it is followed by your entry for a relation and amount -'
? '      OFFERING FIELD CATEGORIES -'
?
Store '0' to N
?? '0 - PLEDGED  '
Do while N<>OT
  Store str(val(N)+1,1) to N
  ?? ' ',N,'-',OCATNAM&N
enddo
  ?
Accept 'Enter category  number ' to catnumb
Do while @(catnumb,'012345Qq')=0.or.val(catnumb)>val(OT)
  Accept 'Invalid entry. Please enter again ' to catnumb
enddo
Store d+':MEMBCON' to MFILEC
Store d+':CONTRIB' to MFILE
If !(catnumb)<>'Q'
  Select primary
  Use &MFILE
  Accept 'Enter relation, amount (<RETURN>=all) ' to XX
  If catnumb='0'
    Store "val(PLEDGED)"+XX to selcri
  else
    Store 'val($(OCATEG&catnumb,1,9))'+XX to selcri
  endif
  Accept 'Enter input file name (Press <RETURN> for "MEMBERS") ' to MFILEM
  If MFILEM=' '
    Store D+':MEMBERS' to MFILEM
  else
    Store D+':'+MFILEM to MFILEM
  endif
  If .not. file(MFILEM)
    ? 'Input file',MFILEM,'not found on the data disk.'
    Accept 'Press <RETURN> to exit ' to xx
  else
  ? 'Now creating',MFILEC,'from',MFILEM,'of all',selcri
  Select secondary
  Use &MFILEM
  Set talk on
  Replace all membstatus with $(membstatus,1,9)+' '
  Set talk off
  Use &MFILEM
  Store 0 to rec
  Store 0 to recc
  Do while .not. EOF
    Store T to NOSELECT
    Store T to NOOFFER
    Do while (NOOFFER .or. NOSELECT) .and. .not. EOF
      If offeringen<1 .or. offeringen > offermax
        Store T to NOOFFER
      else
        Store F to NOOFFER
        Store offeringen to offr
        Select primary
        GOTO offr
        Store T to NOSELECT
        If &selcri
          Store F to NOSELECT
          Select secondary
          Replace membstatus with $(membstatus,1,9)+'.'
        endif
      endif
      Select secondary
      SKIP
    enddo
    Store rec+1 to rec
    If rec=50
      Store 0 to rec
      Store 50+recc to recc
      ? recc,'RECORDS PROCESSED'
    endif
  enddo
  Use &MFILEM
  ? 'Good MEMBER records are now marked. Now creating the MEMBCON file.'
  Set talk on
  Copy to &MFILEC for $(membstatus,10,1)='.'
  Use &MFILEC
  ?? '.   Now indexing by name.'
  Index on last:name+first:name to &MFILEC
  Set talk off
  ? 'New MEMBCON file is now created.'
  endif
endif
Release catnumb,mfilec,rec,recc,noselect,nooffer,offr,NOOFFER,NOSELECT,SELCRI
Accept 'Press <RETURN> ' to xx
    endcase
  endif
enddo
RETURN

t9,wg10,wg11,wg12
Accept 'Editing