home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr2.zip
/
CSANSWRS.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1987-01-06
|
6KB
|
238 lines
* Program CSANSWRS - Allows entry of Survey answers for everyone in MEMBERSS.
Store d+':MEMBERSS' to MFILE
Select secondary
Use CSURVEY
GOTO 10
Store csanswrsx+' ' to valansw
Select primary
Use &MFILE index &MFILE
Store T to cscontin
Store F to invalcc
DO WHILE CSCONTIN
If .not. invalcc
? 'Enter LAST NAME (3 characters) and FIRST NAME (2 characters) '
Accept ' Name code ' to INHH
Store T to invalcc
Store F to MATCH
Do while invalcc
If len(INHH) = 1 .and. !(INHH) = 'Q'
Store F to invalcc
Store F to cscontin
else
If len(INHH) <> 5
Accept 'Invalid entry - must be 5 characters. Please re-enter ' to INHH
else
Store !($(INHH,1,1))+$(INHH,2,2) to INLN
Store !($(INHH,4,1))+$(INHH,5,1) to INFN
Store F to invalcc
endif
endif
enddo
If CSCONTIN
? 'Matching ',trim(INLN),'..., ',trim(INFN),'...'
Store T to MATCHINGL
Store T to MATCHING
FIND &INLN
If # = 0
Accept 'No match. Press <retn> to continue. ' to XX
else
Do while MATCHING
Store T to PMATCHING
Do while PMATCHING *(partial matching)
Store T to NXTMATCH
Do while NXTMATCH
If EOF .or. $(last:name,1,3) <> INLN
Store F to MATCHINGL
Store F to MATCHING
Store F to PMATCHING
Store F to NXTMATCH
Store F to MATCH
else
Store F to NXTMATCH
endif
enddo * NXTMATCH
If MATCHINGL
If $(FIRST:NAME,1,2) = INFN
Store F to PMATCHING
Store T to MATCH
else
SKIP
endif
endif
enddo *(PMATCHING)
If match
? 'Name: ',trim(last:name),', ',trim(first:name),' Phone: ',home:phone
Accept 'Is this the right name and phone? ' to xx
If !(xx)='Y'
Store F to MATCHING
else
Store T to MATCHING
Store F to MATCH
SKIP
endif
endif
enddo * (MATCHING)
endif
endif
endif
If MATCH
Store $(P.ssscattd,1,20) to CSURV1
Store $(P.ssscattd,21,20) to CSURV2
Store $(P.ssscattd,41,19)+' ' to CSURV3
Store '11' to SET
Store '1' to II
Store F to DONE
Store ' ' to invala
Store trim(P.last:name)+', '+trim(P.first:name) to xname
Store ' TEL: '+P.home:phone to tel
Do while .not.EOF .and. .not.DONE
Store T to invalansw
Erase
Do while invalansw
If ' '<>invala
@ 23,0 say 'INVALID ANSWERS :'+invala
else
@ 1,26 say 'CHURCH SURVEY PROCESSING '+CURDATE
@ 2,0 say xname+tel
@ 2,66 say MFILE
endif
Store 'A' to I
Store 1 to cl
Select secondary
GOTO &SET
Store val(II)*20-20 to III
Do while cl<21
If ' '=invala
@ cl+2,0 say str(cl+III,2)+'.'
@ cl+2,8 say csanswrsx+' '+QU1
Store $(csurv&II,cl,1) to NN&I
endif
@ cl+2,4 get NN&I
SKIP
Store cl+1 to cl
Store chr(rank(I)+1) to I
enddo
READ
If ' '<>valansw
Store 'A' to I
Store ' ' to invala
Store 1 to cl
Do while cl<21
If @(NN&I,valansw)=0
Store invala+str(cl+III,3) to invala
endif
Store cl+1 to cl
Store chr(rank(I)+1) to I
enddo
If ' '=invala
Store F to invalansw
else
@ 23,0 say ;
' '
endif
else
Store F to invalansw
endif
enddo
Accept ;
'Select: [N]ext screen [B]ack a screen [S]ave this record [Q]uit ' TO ES
Store T to inval2
Do while inval2
Store F to inval2
Do CASE
CASE !(ES)='S'
STORE NNA+NNB+NNC+NND+NNE+NNF+NNG+NNH+NNI+NNJ+NNK+NNL+NNM+NNN+;
NNO+NNP+NNQ+NNR+NNS+NNT TO CSURV&II
Select primary
Replace ssscattd with csurv1+csurv2+csurv3
Store T to DONE
CASE !(ES)='N'
Store NNA+NNB+NNC+NND+NNE+NNF+NNG+NNH+NNI+NNJ+NNK+NNL+NNM+NNN+NNO to XX
Store XX+NNP+NNQ+NNR+NNS+NNT TO CSURV&II
Select primary
Replace ssscattd with csurv1+csurv2+csurv3
If II='3'
Accept 'Invalid entry - this is the last screen. enter again ' to es
Store T to inval2
else
Store str(val(II)+1,1) to II
Store str(11+val(II)*20,2) to SET
endif
CASE !(ES)='B'
Store NNA+NNB+NNC+NND+NNE+NNF+NNG+NNH+NNI+NNJ+NNK+NNL+NNM+NNN+NNO to XX
Store XX+NNP+NNQ+NNR+NNS+NNT TO CSURV&II
Select primary
Replace ssscattd with csurv1+csurv2+csurv3
If II='1'
Accept 'Invalid entry - this is the first screen. Enter again ' to es
Store T to inval2
else
Store str(val(II)-1,1) to II
Store str(11+val(II)*20,2) to SET
endif
CASE !(es)='Q'
Store T to done
Select primary
otherwise
Accept 'Invalid entry. Please enter again [N/B/S/Q] ' to es
Store T to inval2
endcase
enddo
enddo
? 'Record for "',xname,'" is processed.'
If len(es)=1
Accept 'Select: [N]ext name [A]nother name [Q]uit ' to ES
else
Store $(es,2,1) to ES
endif
Store T to inval2
Do while inval2
Store F to inval2
DO CASE
CASE !(ES)='N'
SKIP
If EOF
Store F to CSCONTIN
else
Store T to invalcc
endif
CASE !(ES)='A'
Store F to invalcc
If EOF
Store F to CSCONTIN
endif
CASE !(ES)='Q'
USE
Store F to CSCONTIN
otherwise
Accept 'Invalid entry. Please enter again [N/B/Q] ' to ES
Store T to inval2
ENDCASE
enddo
else
If CSCONTIN
Accept 'No match for this name. Press <retn> ' to xx
endif
endif
enddo
RETURN
tore F to PMATCHING
Store T to MATCH
else
SKIP
endif
endif
enddo *(PMATCHING)
If match
? 'Name: ',trim(last:name),', ',trim(first:name),' Phone: ',home:phone
Accept 'Is this the right name and phone? ' to xx
If !(xx)='Y'
Store F to MATCHING
else
Store T to MATCHING
Store F to MATCH
SKIP
endif
endif
end