common ret%
rem - program SSPM.BAS
rem - PERCH I system program menu
rem - Copyright Peter C. Hawxhurst 1982
rem - revised 05/27/1982
rem - variable descriptions **********************
rem   c   = line number counter
rem   i%  = for next loop counter
rem   n$  = program name
rem   p$  = program description
rem   r   = routine number selection
rem   r$  = chained program name
rem   s1  = end switch
rem   s2  = headings switch
rem   s3  = error switch
rem   q$  = carriage return
rem   q1$ = routine number input
rem   x   = numeric check variable
rem   y   = decimal point location
rem   z   = numeric check equivalant
rem - program structure **************************
gosub 100 : rem - housekeeping
001 if s1=1 then 002 
gosub 200 : rem - process
goto 001
002 gosub 300 : rem - end of job
initialize
%chain 50,9000,500,500
chain r$(r)
100 rem - housekeeping subroutine ****************
dim n$(26)
dim r$(15)
let s2=1 
let ret%=1
read p$,n$
return
200 rem - process subroutine *********************
if s2=1 then gosub 500 : rem - headings
let s2=0
let c=c+1
print tab(12);c;" ";n$
let r$(c)=p$
read p$,n$
if p$="END" then 280
goto 290
280 let s1=1
290 return
300 rem - end of job subroutine ******************
310 gosub 600 : rem - cursor
print chr$(27)+"="+chr$(52)+chr$(44);
input "Number of routine required >";q1$
let x$=q1$
gosub 400 : rem - numeric check
if s3=0 then 320
goto 310
320 let r=val(q1$)
if r<0 then 310
if r>c then 310
if r<>int(r) then 310
if r=8 then 330
if r<>0 then 390
print chr$(26)
initialize
stop
330 print chr$(27)+")";
340 print chr$(27)+"="+chr$(49)+chr$(36);
input "(C)heck disk or (L)oad new disk in B drive >";q9$
q9$=ucase$(q9$)
print chr$(27)+"="+chr$(49)+chr$(33);
print chr$(27)+"T";
if q9$<>"C" and q9$<>"L" then print chr$(7);
if q9$<>"C" and q9$<>"L" then 340
if q9$="C" then 360
print chr$(27)+"="+chr$(49)+chr$(36);
input "Load new disk in drive B and press RETURN >";line q$
initialize
350 print chr$(27)+"="+chr$(49)+chr$(33);
print chr$(27)+"T";
print chr$(27)+"(";
goto 310
360 z=size("B:*.*")
space%=int(((46-z)/46)*100)
print chr$(27)+"="+chr$(49)+chr$(35);
print "Data space on B:is about";space%;"%";
input " - press RETURN >";line q$
goto 350
390 return
400 rem - numeric check subroutine ***************
let s3=0
let x=0
let y=0
let z=0
let y=y+match(".",x$,1)
for i%=1 to len(x$)
let z=z+i%
next i%
if y=0 then 410
let z=z+1
410 for i%=1 to len(x$)
let x=x+match("#",x$,i%)
next i%
if x=z then 490
let s3=1
gosub 600
print chr$(27)+")";
print chr$(27)+"="+chr$(52)+chr$(44);
print "Error - non numeric data!!!"
print chr$(27)+"="+chr$(53)+chr$(44);
input "Press - RETURN - to retry >";line q$
print chr$(27)+"(";
490 return
500 rem - headings subroutine ********************
print chr$(26)
print tab(14);"    PERCH I SUB-SYSTEM"         
print tab(14);"       PROGRAM MENU"
print
print
print tab(13);"0  EXIT TO CONTROL PROGRAM"
return
600 rem - cursor subroutine **********************
print chr$(27)+"="+chr$(52)+chr$(33);
print chr$(27)+"R";
print chr$(27)+"="+chr$(53)+chr$(33);
print chr$(27)+"R";
print chr$(27)+"="+chr$(52)+chr$(33);
return
data "UCRF","UPDATE CASH RECORD FILE"
data "VBS","VERIFY  BANK  STATEMENT"
data "UCCF","UPDATE CREDIT CARD FILE"
data "VCS","VERIFY CREDIT STATEMENT"
data "LPT","LOAN PAYMENT TABULATION"
data "DST","DECISION  SUPPORT  TOOL"
data "CFAM","CALENDARS FOR ANY MONTH"
data "DUMMY","CHECK/CHANGE DISK IN B:"
data "SYSTEM","RETURN TO PERCH  I MENU"
data "END","END"
