home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
chrchpr2.zip
/
CSQUESTS.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1987-01-06
|
5KB
|
208 lines
* Program CSQUESTS - Enables operator entry of Survey questions
If msel='2'
Select secondary
Accept 'Do you want a new, clear questions file? [Y/N] ' to xx
If !(xx)='Y'
Use CSURVEYX
Copy to CSURVEY
Use CSURVEY
Store 0 to II
Do while II<68
Store II+1 to II
Append blank
enddo
? 'A clear CSURVEY file has now been made on the program disk.'
GOTO 2
If @(!(D),'ABCDEFGHI')<>0
Replace QU1 with $(qu1,1,11)+!(D)
endif
endif
Use CSURVEY
GOTO 10
Store 1 to II
Store '11' to SET
Store F to DONE
@ 18,1 say chname+' - CSURVEY Questions Entry '+curdate
@ 19,10 say 'The current valid answer set is ' get csanswrsx
@ 20,10 say 'TITLE1 ' get QU1
@ 21,10 say 'TITLE2 ' get QU2
@ 22,10 say 'TITLE3 ' get QU3
? ' Press ctrl-W to complete entries'
READ
Store trim(csanswrsx)+' ' to valansw
Do while .not.DONE
Erase
@ 1,1 say chname+' - CSURVEY Questions Entry '+curdate
@ 3,20 say 'VALID SURVEY ANSWERS: >'+valansw+'<'
Store 1 to cl
Store 'A' to I
Store val(SET)-11 to III
GOTO &SET
Store str(1+III,2)+'. ' to xx
@ 5,1 say 'QUESTION '+xx get QU1
@ 6,14 get QU2
@ 7,14 get QU3
@ 9,1 say 'VALID ANSWERS'
@ 9,14 get AN1
@ 10,14 get AN2
@ 11,14 get AN3
@ 12,14 get AN4
@ 13,14 get AN5
@ 14,14 get AN6
@ 15,14 get AN7
@ 16,14 get AN8
READ
Accept 'Select: [N]ext question [B]ack a question [S]ave [Q]uit ' to es
Store T to inval2
Do while inval2
Store F to inval2
Do CASE
CASE !(es)='N' .or. !(es)='B' .or. !(es)='S'
Store '1' to I
Store $(AN1,1,1) to answ
Do while I<>'8'
Store str(val(I)+1,1) to I
Store answ+$(AN&I,1,1) to ANSW
enddo
Replace CSANSWRSX with ANSW
If !(es)='N'
If SET='70'
Accept 'Invalid entry. This is the last screen. Enter again ' to es
Store T to inval2
else
Store str(val(SET)+1,2) to SETT
endif
else
If SET='11'
Accept 'Invalid entry. This is the first screen. Enter again ' to es
Store T to inval2
else
Store str(val(SET)-1,2) to SETT
endif
endif
If .not. inval2
Store SETT to SET
endif
If !(ES)='S'
GOTO &SET
Store T to DONE
endif
CASE !(ES)='Q'
Store T to DONE
otherwise
Accept 'Invalid entry. Please enter again ' to es
Store T to inval2
ENDCASE
ENDDO
enddo
else
Select secondary
Use CSURVEY
GOTO 10
? 'Now printing the survey form for the following function -'
? ' ',qu1
? ' ',qu2
? ' ',qu3
?
Store trim(qu1) to qux
If len(qux)<50
Store ' '+qux to qux
endif
SKIP
Set format to print
Store 0 to pag
Store 99 to cl
Store ' 1' to QUN
Do while qu1<>' '
If cl>54
If cl<99
EJECT
endif
Store pag+1 to pag
@ 1,0 say qux
@ 1,63 say curdate
If cl=99
@ 2,10 say qu2
endif
@ 2,70 say 'Page'+str(pag,3)
If cl=99
@ 3,10 say qu3
@ 4,1 say 'NAME: ____________________________________________________'
Store 7 to cl
else
Store 4 to cl
endif
endif
@ cl-1,1 say QUN+'. '+qu1
If qu2<>' '
@ cl,5 say qu2
Store cl+1 to cl
If qu3<>' '
@ cl,5 say qu3
Store cl+1 to cl
endif
endif
Store '1' to I
Store T to twocolm
Do while AN&I<>' '.and.I<>'9'
If len(trim(AN&I)) > 25
Store F to twocolm
endif
Store str(val(I)+1,1) to I
enddo
Store '0' to II
If twocolm
Store str(val(I)/2,1) to I
Store I to IM
Do while II<>I
Store str(val(II)+1,1) to II
Store str(val(IM)+1,1) to IM
Store trim(AN&II) to ANII
Store trim(AN&IM) to ANIM
@ cl,7 say ANII
@ cl,40 say ANIM
Store cl+1 to cl
enddo
else
Store '0' to II
Do while II<>I
Store str(val(II)+1,1) to II
@ cl,7 say trim(AN&II)
Store cl+1 to cl
enddo
endif
SKIP
Store str(val(QUN)+1,2) to QUN
Store cl+2 to cl
enddo
@ cl,0 say '.'
EJECT
Set format to screen
USE
Select primary
endif
RETURN
USE
Select primary
endif
RETURN
ant a new, clear questions file? [Y/N] ' to xx
If !(xx)='Y'
Use CSURVEYX
Copy to CSURVEY
Use CSURVEY
Store 0 to II
Do while II<68
Store II+1 to II
Append blank
enddo
? 'A clear CSURVEY file has now been made on the program disk.'
Accept 'Enter data disk letter ' to D
GOTO 2
If @(!(D),'ABCDEFGHI')<>0
Replace QU1 with $(qu1,1,11)+!(D)
endif
endif