home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr2.zip
/
CSURVEY.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1987-01-06
|
7KB
|
218 lines
* Program CSURVEY - Controls all CHURCH SURVEY program operations
Clear
Set talk off
Set bell off
Set deleted on
Set intensity off
Set exact off
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
Store VAL(curmonthx) to CURYEAR
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
Store curmonthx+curyear to curdate
Select primary
USE CSURVEY
Store trim($(QU1,1,27)) to chname
GOTO 2
Store !($(QU1,12,1)) to D
USE
release curmo,months,curyear,curmonthx,nmonth
Store d+':MEMBERSS' to MFILE
Store T to LEVEL2
Do while LEVEL2
Save to UMEMVARS
Select primary
Erase
@ 2,1 say 'DATA DISK = '+D
@ 2,61 say curdate
@ 3,20 SAY ' C S U R V E Y 6-/CSURVEY/'
@ 5,13 say ' Processes Survey Data and Makes Summary Reports'
@ 7,9 say ' 1) Clear the MEMBERSS file and re-index'
@ 8,9 say ' 2) Enter Survey Questions, Possible Answers /CSQUESTS/'
@ 9,9 say ' 3) Print the Survey form /CSQUESTS/'
@ 10,9 SAY ' 4) Enter Individual Member Answers /CSANSWRS/'
@ 11,9 say ' 5) Display/Print Summary Report '
@ 12,9 say ' 6) Set up - Names Directory Editing'
?
Accept ' Enter selection' to MSEL
?
If !(MSEL)='DISK='
Store !($(msel,6,1)) to D
? 'Disk now being set to drive ',D
Save to UMEMVARS
else
Store F to validd1
Do while .NOT. validd1
Store T to validd1
Do CASE
CASE MSEL = '1'
? 'This routine operates on the MEMBERSS file, which is from the MPROFILE'
?? 'program'
? 'The operator needs to make a copy of the main MEMBERS file, with the'
?? 'alternate'
? 'name, MEMBERSS, and have that disk as the data disk. Or you may want to'
?? 'select'
? 'a certain group of MEMBERS for this survey. You would perform the "Special'
? 'Files, Create a new file" process from MPROFILE, then name the new file'
?? 'MEMBERSS.'
? 'The MEMBERS.NDX file is not needed. This Survey process just needs a file'
? 'called MEMBERSS that has most of the same data fields as the MEMBERS file.'
Accept ' - - - - - - O K T O G O A H E A D ? ' to XX
If !(XX)='Y'
STORE D+':MEMBERSS' to MFILE
If .not. file(MFILE)
Accept 'MEMBERSS file not found on the data disk. Press <retn>' to XX
else
Use &MFILE
Accept 'Now about to clear the answer field of each MEMBERSS record. OK?' to XX
If !(XX)='Y'
? 'Now clearing the answers field of the MEMBERSS file for each member.'
Set talk on
Replace ALL ssscattd with ' '
? 'Now indexing the MEMBERSS file.'
Index on last:name+first:name to &MFILE
Set talk off
Accept ;
'The MEMBERSS file has now been cleared for a new survey. Press <RETN>' to XX
endif
endif
endif
CASE MSEL = '2'
DO CSQUESTS.CMD
Release xx,ii,set,sett,done,valansw,cl,i,iii,es,inval2,answ
CASE MSEL = '3'
DO CSQUESTS.CMD
Release xx,ii,set,sett,done,valansw,cl,iii,i,es,inval2,answ
CASE MSEL = '4'
Do CSANSWRS.CMD
Release valansw,cscontin,invalcc,inhh,match,inln,infn,matchingl,matching,
Release pmatching,nxtmatch,xx,csurv1,csurv2,csurv3,set,ii,done,invala,xna
Release xname,tel,invalansw,i,cl,iii,nna,nnb,nnc,nnd,nne,nnf,nng,nnh,nni
Release nnj,nnk,nnl,nnm,nnn,nno,nnp,nnq,nnr,nns,nnt,es,inval2
CASE MSEL = '5'
Select secondary
Use CSURVEY
GOTO 10
? ' ',chname,' - Survey Report ',curdate
?
? ' ',QU1
SKIP
Select primary
Use &MFILE
?
? ' Names being processed:'
COUNT ALL to ME
?? ME
? ' Names with responses:'
use membssx
Copy structure to MEMBSS
Use MEMBSS
Store d+':MEMBERSS' to xx
Append from &XX for ;
SSSCATTD<>' '
Use MEMBSS
goto bottom
Store # to MR
?? MR
GOTO TOP
Store 1 to NMAX
Store 0 to NN
Select secondary
? '___________________________________________________________________________'
?
If MR=0
? 'None of the names in the MEMBERSS file have responses.'
else
Do while CSANSWRSX<>' '
Store NN+1 to NN
Store 0 to xc
Store len(trim(CSANSWRSX)) to xcmax
? str(#-10,3),'. ',csanswrsx,QU1
Select primary
Replace ALL calling with $(ssscattd,NN,1)
Select secondary
Set raw off
Do while xc<xcmax
Store xc+1 to xc
Store str(xc,1) to CC
Store $(csanswrsx,xc,1) to namea
Select primary
COUNT ALL for calling = namea to answ
Select secondary
Set exact on
Store str(answ/MR*100,3) to answper
? str(answ,7),answper,'% ',an&CC
Set exact off
enddo
Set raw on
Select primary
COUNT ALL for calling =' ' to ANSW
Select secondary
Store str(answ/MR*100,2) to answper
? ' ',ANSW,' ',answper,' % (no response) '
?
SKIP
enddo
endif
Release ME,MR,ANSW,ANSWPER,namea,cc,xc,xcmax,nn,nmax,qux,pag,cl,qun,i,twocolm
Release im,anii,anim
Accept 'Report is complete. Press <retn>' to xx
CASE MSEL = '6'
Select secondary
Use CSURVEY
Store $(QU1,1,27) to chname
GOTO 2
Store $(QU1,12,1) to D
@ 19,8 say ' NAMES DIRECTORY EDITING '
Set intensity off
@ 21,12 say 'church name ' get chname
@ 22,12 say 'data disk ' get D
READ
Set intensity off
? 'Now writing the parameters into the Names Directory file (CSURVEY).'
Replace QU1 with $(QU1,1,11)+D
GOTO 1
Replace QU1 with chname
Use
Save to FMEMVARS
Select primary
CASE !(MSEL) = 'Q'
Select secondary
USE
Select primary
USE
Store F to LEVEL2
OTHERWISE
Accept 'Illegal selection. Please enter again ' to MSEL
Store F to validd1
ENDCASE
ENDDO
endif
ENDDO
Restore from UMEMVARS
ENDDO
Store T to LEVEL1
Store T to validd1
RETURN
namea
Select primary
COUNT ALL for calling = namea to answ