2 'ADAPTED FOR CP/M AND MICROSOFT BASIC 5.01 ON 5/11/80
3 'FOR 4.51 ON 3/18/81, AND FOR MODEL III ON 2/20/83, FOR CP/M AND MBASIC 4.51/5.2+ AGAIN ON 3/23/83; FOR 48K CP/M ON 7/2/83 WITH OVERLAYS; THIS IS THE FIRST OVERLAY
4 'THIS IS PUBLIC DOMAIN SOFTWARE AND MAY NOT BE SOLD OR INCORPORATED IN ANY COMMERCIAL SOFTWARE WITHOUT THE EXPRESS PERMISSION OF THE AUTHOR
5 '
19 GOTO 660
20 FX=0:IF LEN(CV$)<1 THEN RETURN
30 FOR II=1 TO LEN(CV$):CV%=ASC(MID$(CV$,II,1)):IF CV%=34 AND FX=0 THEN FX=1:ELSE IF CV%=34 AND FX=1 THEN FX=0
40 IF CV%>90 AND FX=0 THEN CV%=CV% AND 95
50 MID$(CV$,II,1)=CHR$(CV%):NEXT II:RETURN
660 PRINT CLS$;"Which field is the key field? Input the field number:";:INPUT KF
670 PRINT #1,"35005 GET 2,1:KP=CVI(KP$):FOR K=1 TO KP:RP=K:GET 1,K":PRINT #1,"35010 IF F$(";KF;")>CHR$(249) THEN 35990"
680 PRINT #1,"35000 PRINT CLS$:INPUT";Q$;"Field number to scan (1-";A;")";Q$;";NS:IF NS<1 OR NS>";A;" THEN 35000":PRINT #1,"35990 NEXT K:GOTO";SL
690 LN=1000:FOR QR=1 TO KF-1:FT=FT+VAL(F$(QR)):NEXT QR:GOSUB 700:GOTO 810
700 PRINT CLS$;"Now we must describe the input prompts the operator will see,":PRINT"the edits to be performed, and the kind of data for each field.":PRINT"To do this, we will ask a series of questions about each field."
710 PRINT"To the question KIND OF DATA, the possible responses are:":PRINT"N..............numeric data, not packed, stored as characters."
720 PRINT"PH..............packed half-precision, stored as one character.":PRINT"PI............packed integer data, stored as two characters."
730 PRINT"PS........packed single precision data, stored as 4 characters.":PRINT"PD........packed double precision data, stored as 8 characters."
740 PRINT"C.........................character data, stored as characters.":PRINT"To the PROMPT question, type the message the operator will see."
750 PRINT"To the BAD INPUT IF question, type as many edits as you wish of":PRINT"the form: >999 <";Q$;"A";Q$;" NOT NUMERIC NO ENTRY":PRINT"LENGTH>9 NOT ALPHA CONTAINS";Q$;"Z";Q$;" >=4 <>6"
760 PRINT"Note the quotes around alpha edits. Depress any key for more:";
770 PZ$=INKEY$:IF PZ$="" THEN 770
780 PRINT CLS$;"To the question ERROR MESSAGE, type the message the operator":PRINT"will see if that error is made. You may signal completion of":PRINT"edits for any field by just depressing the enter key. To repeat"
790 PRINT"these directions, type HELP. NOW DEPRESS ANY KEY TO CONTINUE:";
800 PZ$=INKEY$:IF PZ$="" THEN 800:ELSE PRINT:RETURN
810 FOR I=1 TO A:I$=MID$(STR$(I),2):PRINT"FIELD #";I;" LENGTH=";:L=VAL(F$(I)):PRINT L
820 P$="":PRINT"PROMPT:";:LINE INPUT P$:IF P$="HELP" THEN GOSUB 700:GOTO 820
830 INPUT"Should the prompt and reply be on the same line (Y/N):";NY$:CV$=NY$:GOSUB 20:NY$=CV$:IF CV$="Y" THEN NY$=";":ELSE NY$=""
840 K$="":PRINT"KIND OF DATA:";:IF L<>1 AND L<>2 AND L<>4 AND L<>8 THEN PRINT"C":K$="C":ELSE LINE INPUT K$:CV$=K$:GOSUB 20:K$=CV$:IF K$="HELP" THEN GOSUB 700:GOTO 840
850 IF K$="PH" OR K$="PI" OR K$="PS" OR K$="PD" OR K$="C" OR K$="N" THEN 870
860 PRINT"INVALID DATA TYPE: USE PH, PI, PS, PD, N OR C ONLY!":GOTO 840
870 IF (K$="PH" AND L=1) OR (K$="PI" AND L=2) OR (K$="PS" AND L=4) OR (K$="PD" AND L=8) OR (K$="N") OR (K$="C") THEN 890
880 PRINT"INCORRECT LENGTH FOR VARIABLE TYPE!":GOTO 840
890 LN=LN+10:PRINT #1,LN;"PRINT";Q$;P$;Q$;NY$:BL=LN:IF K$<>"C" THEN PRINT #1,BL+1;"IF UF<>0 AND G$=";Q$;Q$;" THEN G$=G$(";I$;")"
980 LN=LN+10:PRINT #1,LN;"IF ABS(VAL(G$(";I$;")))>32767 THEN PRINT";Q$;"NUMBER OUT OF RANGE. MUST BE FROM -32767 TO 32767.";Q$;":GOTO";BL
990 IF K$<>"PH" THEN 1010
1000 LN=LN+10:PRINT #1,LN;"IF ABS(VAL(G$(";I$;")))>127 THEN PRINT";Q$;"NUMBER OUT OF RANGE. MUST BE FROM -127 TO 127.";Q$;":GOTO";BL
1010 IF K$="PI" OR K$="PH" THEN LN=LN+10:PRINT #1,LN;"IF G$(";I$;")=";Q$;"0";Q$;" THEN";LN+20
1020 IF K$<>"PI" AND K$<>"PH" THEN 1040
1030 LN=LN+10:PRINT #1,LN;"IF INT(VAL(G$(";I$;")))<>VAL(G$(";I$;")) THEN PRINT";Q$;"MUST BE A WHOLE NUMBER.";Q$;":GOTO";BL
1040 BI$="":PRINT"Bad input if:";:LINE INPUT BI$:CV$=BI$:GOSUB 20:BI$=CV$:IF BI$="" THEN 1260
1050 IF INSTR(BI$,"LENGHT")>0 THEN PRINT"MISSPELLED WORD":GOTO 1040
1060 IF BI$="HELP" THEN GOSUB 700:GOTO 1040
1070 PRINT"Error message:";:LINE INPUT EM$:IF EM$="HELP" THEN GOSUB 700:GOTO 1070
1080 PRINT"Is this a fatal error or a non-fatal error? A fatal error":PRINT"simply means the operator must try inputting this field until":PRINT"the input is correct; a non fatal error means the error message"
1085 PRINT"will be printed as a warning, but the (possibly) erroneous":PRINT"input will be accepted. Depress F if the error is FATAL, or any":PRINT"other key, if not a fatal error: ";
1090 FE$=INKEY$:IF FE$="" THEN 1090:ELSE CV$=FE$:GOSUB 20:FE$=CV$:PRINT FE$:IF FE$="F" THEN FE$=":GOTO"+STR$(BL):ELSE FE$=" "
1100 IF INSTR(BI$,"NOT NUMERIC") THEN S3%=1:GOTO 1130
1110 IF INSTR(BI$,"NOT ALPHA") THEN S4%=1:GOTO 1140 ELSE IF INSTR(BI$,"NO ENTRY") THEN 1150
1120 IF INSTR(BI$,"CONTAINS") THEN 1160 ELSE IF INSTR(BI$,"LENGTH") THEN 1200 ELSE 1210
1130 LN=LN+10:PRINT #1,LN;"CD$=G$(";I$;"):E=0:GOSUB 30000:IF E=1 THEN PRINT";Q$;EM$;Q$;FE$:GOTO 1040
1140 LN=LN+10:PRINT #1,LN;"CD$=G$(";I$;"):E=0:GOSUB 31000:IF E=1 THEN PRINT";Q$;EM$;Q$;FE$:GOTO 1040
1150 LN=LN+10:PRINT #1,LN;"IF LEN(G$(";I$;"))=0 THEN PRINT";Q$;EM$;Q$;FE$:GOTO 1040
1160 FH=INSTR(BI$,Q$):IF FH<1 THEN PRINT"YOU FORGOT QUOTES.":GOTO 1040
1170 IF FH<1 THEN 1190
1180 FH$=MID$(BI$,FH+1,1):LN=LN+10:PRINT #1,LN;"IF INSTR(G$(";I$;"),";Q$;FH$;Q$;")>0 THEN PRINT";Q$;EM$;Q$;FE$:FH=0:GOTO 1040
1190 PRINT"SYNTAX ERROR. CONTAINS should not be set off by quotes.":GOTO 1040
1200 FH=INSTR(BI$,"LENGTH"):LN=LN+10:PRINT #1,LN;"IF LEN(G$(";I$;"))";MID$(BI$,FH+6);" THEN PRINT";Q$;EM$;Q$;FE$:FH=0:GOTO 1040
1210 IF INSTR(BI$,"<")<1 AND INSTR(BI$,">")<1 AND INSTR(BI$,"=")<1 THEN 1220 ELSE 1230
