HP 3000 Manuals HP 3000 Manuals
BASIC
60 REM This program controls source data entry for any forms file.
65 REM It prompts the user for the name of a forms file and opens it
70 REM if possible. It also prompts for the name of a BATCH file and
75 REM opens it if possible. If all is OK, it displays the HEAD FORM
80 REM accepts input, edits the data, and if no errors, writes data
85 REM to the BATCH file. This process continues until the form with
90 REM name $END is encountered or the EXIT function key is pressed.
95 REM
100 REM This program also provides BROWSE control and permits
105 REM modification of the collected data.
110 REM
115 REM The function keys have the following meanings:
120 REM
125 REM f1 f2 f3 f4
130 REM HEAD DELETE PRINT REFRESH
135 REM
140 REM f5 f6 f7 f8
145 REM PREV NEXT BROWSE/ EXIT
150 REM COLLECT
155 REM
160 REM The following variable assignments are used:
165 REM
170 REM Strings:
175 REM
180 REM B$[16] - Name of current Form
185 REM B0$[16] - Saves B$ during BROWSE
190 REM B1$[16] - Name of next Form
195 REM E$[60] - Entry error messages
200 REM M$[150] - General messages
205 REM S$[150] - Status line
210 REM U$[150] - General user input and file names
220 REM
225 REM Integers:
230 REM
235 REM B1 - Batch : O=false; 1=true
240 REM F1 - First time : O=false; 1=true
245 REM W1 - Max window length (150)
250 REM R1 - Saves number of last accessed record in batch file
255 REM D1 - Browse direction: O=forward; 1=backward
260 REM R2 - Local batch record number
265 REM
270 REM E - Errors Flag : O=false; 1=true
275 REM
280 REM
285 REM Com area Array C(1:60)
295 REM C(1) - Status (O=OK; >0 ERROR)
300 REM C(2) - Language (1=BASIC)
305 REM C(3) - Com area length (60)
310 REM C(4) - Com extension length (2000)
315 REM C(5) - Mode
320 REM C(6) - Lastkey (# of last used function key)
325 REM C(7) - Numerrs
330 REM C(8:10) - not used
335 REM C(11:18) - name of current form (packed)
340 REM C(19:26) - name of next form (packed)
345 REM C(27) - Repeat option
350 REM C(28) - NF option
355 REM C(29) - not used
360 REM C(30) - Length of data buffer
365 REM C(31) - not used
370 REM C(33) - Delete flag
375 REM C(34) - Show control
380 REM C(35:42) - not used
385 REM C(43:44) - Number of recs in batch file (double)*
390 REM C(45:46) - Record # in batch file (double)*
395 REM C(47,48) - not used
400 REM C(49) - Terminal file #
405 REM C(56) - Terminal options
410 REM
415 REM *Only c(44) and c(46) are used in this program.
420 REM Therefore, this program cannot handle BATCH files
425 REM that have more than 32768 records.
430 REM
450 REM
451 REM *************************************************************
452 REM
500 REM2 ** DECLARATIONS **
510 DIM B$[16],B0$[16],B1$[16],C$[2]
520 DIM E$[60],M$[150],S$[150],U$[150],X$[2]
530 INTEGER B1,D1,F1,E,I,J,R1,R2,W1,X,Y,P,P1
540 INTEGER C[4560]
900 REM2 ** FUNCTIONS **
905 REM1 * UNPACK INTEGER INTO 2 CHARACTERS *
910 DEF FNU$(X)
915 Y=INT(X/256)
920 X=X-256*Y
925 RETURN CHR$(Y)+CHR$(X)
930 FNEND
950 REM1 * PACK 2 CHARACTERS INTO INTEGER *
955 DEF INTEGER FNP(X$)
960 RETURN NUM(X$[2;1])+NUM(X$[1;1])*256
965 FNEND
1000 REM2 ** ENTRY **
1010 REM *INITIALIZE*
1020 GOSUB 2000
1030 REM1 *COLLECT*
1040 GOSUB 3000
1050 REM1 *EXIT*
1060 GOSUB 5000
1070 END
2000 REM2 <INITIALIZE>
2010 MAT C=ZER
2020 C[2]=l
2030 C[3]=60
2040 C[4]=2000
2050 B1=1
2060 E=O
2070 W1=150
2100 REM1 *OPEN FORMS FILE*
2110 C[1]=0
2120 PRINT " Enter FORMS file name and press RETURN: ";
2130 LINPUT U$
2140 IF NOT LEN(U$) THEN 9900
2150 U$=U$+" "
2160 CALL VOPENFORMF(C[*],U$)
2170 IF C[1] THEN DO
2180 GOSUB 9000
2190 GOTO 2100
2200 DOEND
2210 REM1 *OPEN BATCH FILE*
2220 PRINT " Enter BATCH file name and press RETURN: ";
2230 LINPUT U$
2240 IF NOT LEN(U$) THEN B1=0
2250 ELSE DO
2260 U$=U$+" "
2270 CALL VOPENBATCH(C[*],U$)
2280 IF C[1] THEN DO
2290 IF C[1]=70 OR C[1]=73 THEN DO
2300 IF C[1]=70 THEN PRINT "WARNING: A different FORMS file was used to
2305 create this batch."
2310 IF C[1]=73 THEN PRINT "WARNING: FORMS file was recompiled since
2315 this batch was created.
2320 PRINT "Enter "'34"Y"'34" to continue: ";
2330 LINPUT U$
2340 IF UPS$(U$)="Y" THEN C[1]=0
2350 DOEND
2360 ELSE GOSUB 9000
2370 DOEND
2380 DOEND
2390 REM2 ** OPEN TERMINAL **
2400 IF NOT B1 OR NOT C[1] THEN DO
2410 U$="A264X"
2420 CALL VOPENTERM(C[*],U$)
2430 IF C[1] THEN DO
2440 GOSUB 9000
2450 END
2460 DOEND
2470 C[56]=C[56]+8
2480 RETURN
2490 DOEND
2500 ELSE DO
2510 C[1]=0
2520 CALL VCLOSEBATCH(C[*])
2530 CALL VCLOSEFORMF(C[*])
2540 DOEND
2550 GOTO 2100
3000 REM2 <COLLECT>
3005 F1=1
3010 C[5]=C[33]=0
3015 IF NOT C[6] OR C[6]=6 THEN DO
3020 IF NOT C[27] AND NOT C[28] OR C[27]=2 THEN DO
3025 CALL VSHOWFORM(C[*])
3030 IF C[1] THEN GOSUB 9100
3035 DOEND
3040 DOEND
3045 REM1 *COLLECT LOOP*
3050 CALL VGETNEXTFORM(C[*])
3055 IF F1 AND C[1] THEN DO
3060 CALL VERRMSG(C[*],M$,B0,I
3065 E=1
3070 RETURN
3075 DOEND
3080 IF C[1] THEN GOSUB 9100
3085 F1=0
3090 CALL VINITFORM(C[*])
3095 IF C[1] OR C[7] THEN GOSUB 9100
3100 IF NOT E THEN GOSUB 8000
3105 REM1 *SOFTKEY LOOP*
3110 E=O
3115 CALL VSHOWFORM(C[*])
3120 IF C[1] THEN GOSUB 9100
3125 C[34]=0
3130 IF C[30]<=0 AND C[27]=0 AND C[28)<>0 THEN DO
3132 IF NOT E AND B1 THEN DO
3135 CALL VWRITEBATCH(C[*])
3140 IF C[1] THEN GOSUB 9100
3145 IF NOT E THEN DO
3146 C[46]=C[46]+1
3147 P1=20
3148 P=C[46] MOD P1
3149 IF P=0 THEN CALL VPOSTBATCH(C[*])
3150 DOEND
3151 DOEND
3152 DOEND
3155 ELSE DO
3160 CALL VREADFIELDS(C[*])
3165 IF C[1] THEN GOSUB 9100
3170 IF NOT E AND C[6]=8 THEN RETURN
3175 IF NOT E THEN GOSUB C[6]+1 OF 3300,3350,3400,3450,3500,3550,3600,370
3180 DOEND
3185 IF C[6]=8 THEN RETURN
3190 IF E OR C[6]=3 THEN 3105
3195 GOSUB 8100
3200 IF B1$<>"$END" OR C[27] THEN 3045
3205 RETURN
3300 REM2 <ENTER KEY>
3305 CALL VFIELDEDITS(C[*])
3310 IF C[1] OR C[7] THEN GOSUB 9100
3315 IF NOT E THEN DO
3320 CALL VFINISHFORM(C[*])
3325 IF C[1] THEN GOSUB 9100
3330 IF NOT E AND B1 THEN DO
3335 CALL VWRITEBATCH(C[*])
3340 IF C[1] THEN GOSUB 9100
3342 IF NOT E THEN DO
3343 C [46]=C[46]+1
3344 P1 = 20
3345 P=C[46] MOD P1
3346 IF P=O THEN CALL VPOSTBATCH(C[*])
3347 DOEND
3348 DOEND
3349 DOEND
3350 RETURN
3351 REM1 <HEAD KEY>
3355 C[27]=C[28]=O
3360 B1$="$HEAD"
3365 GOSUB 8200
3370 RETURN
3400 REM1 <DELETE KEY>
3410 E$="DELETE key defined only for BROWSE"
3420 GOSUB 9200
3430 RETURN
3450 REM1 <PRINT KEY>
3455 I=1
3460 J=49
3465 CALL VPRINTFORM(C[*],I,J)
3470 IF C[1] THEN GOSUB 9100
3475 RETURN
3500 REM1 <REFRESH KEY>
3505 B1$="$REFRESH"
3510 GOSUB 8200
3515 RETURN
3550 REM1 <PREV KEY>
3555 E$=" The PREV key is only defined for BROWSE mode."
3560 GOSUB 9200
3565 RETURN
3600 REM1 <NEXT KEY>
3610 IF NOT C[27] THEN DO
3620 E$=" The NEXT key is not defined for a non-repeating form."
3630 GOSUB 9200
3640 DOEND
3650 ELSE C[27]=0
3660 RETURN
3700 REM1 <BROWSE KEY>
3710 IF NOT B1 THEN DO
3720 E$=" No BATCH file was specified, so BROWSE is not allowed."
3730 GOSUB 9200
3740 DOEND
3750 ELSE DO
3760 IF NOT C[44] THEN DO
3770 E$=" There are no more batch records."
3780 GOSUB 9200
3790 DOEND
3800 ELSE DO
3810 R1=C[46]
3820 GOSUB 8100
3830 B0$=B$
3840 C[5]=1
3850 C[27]=C[28]=0
3860 GOSUB 4000
3870 C[5]=0
3880 B1$=B0$
3890 GOSUB 8200
3900 C[46]=R1
3910 C[27]=C[28]=C[33]=0
3920 IF C[6]=8 THEN DO
3921 B$=B0$
3922 RETURN
3923 DOEND
3930 DOEND
3940 DOEND
3950 RETURN
4000 REM2 <BROWSE>
4005 R2=C[46]
4010 C[46]=C[46]-1
4015 D1=1
4020 REM1 *BROWSE UNTIL EXIT OR COLLECT KEY*
4025 IF NOT C[44] THEN RETURN
4030 IF C[46]=R1 THEN DO
4035 E$=" There are no more batch records."
4040 GOSUB 9200
4045 C[46]=C[46]-1
4050 D1=1
4055 DOEND
4060 IF C[46]<0 THEN DO
4065 E$=" There are no previous batch records."
4070 GOSUB 9200
4075 D1=C[46]=0
4080 DOEND
4085 CALL VREADBATCH(C[*])
4090 IF C[1] THEN GOSUB 9100
4095 IF NOT C[33] THEN DO
4100 IF C[46]<>R2 OR C[6]=4 THEN DO
4105 IF D1 OR C[6]=4 THEN C[27]=C[28]=0
4110 ELSE DO
4115 GOSUB 8100
4120 IF B$<>B1$ THEN C[27]=0
4125 DOEND
4130 IF C[6]=4 THEN DO
4135 B1 $="$REFRESH"
4140 GOSUB 8200
4145 DOEND
4150 CALL VGETNEXTFORM(C[*])
4155 IF C[1] THEN GOSUB 9100
4160 R2=C[46]
4165 DOEND
4170 IF NOT E THEN GOSUB 8000
4175 REM2 *SOFTKEY LOOP*
4180 E=0
4185 CALL VSHOWFORM(C[*])
4190 IF C[1] THEN GOSUB 9100
4195 C[34]=0
4200 CALL VREADFIELDS(C[*])
4205 IF C[1] THEN GOSUB 9100
4210 IF NOT E AND C [6] >6 THEN RETURN
4215 IF NOT E THEN GOSUB C[6]+1 OF 4300,4400,4450,4500,4550,4600,4650
4220 IF E OR C[6]=3 THEN 4175
4225 DOEND
4230 ELSE DO
4235 IF D1 THEN C[46]=C[46]-1
4240 ELSE C[46]=C[461+1
4245 DOEND
4250 GOTO 4020
4255 RETURN
4300 REM2 <ENTER KEY>
4305 D1=0
4310 CALL VFIELDEDITS(C[*])
4315 IF C[1] 0 C[7] THEN GOSUB 9100
4320 IF NOT E THEN DO
4325 CALL VFINISHFORM(C[*])
4330 IF C[1] THEN GOSUB 9100
4335 IF NOT C[27] AND C[28] OR C[27]=2 THEN DO
4340 CALL VSHOWFORM(C[*])
4345 IF C[1]THEN GOSUB 9100
4350 DOEND
4355 IF NOT E THEN DO
4360 CALL VWRITEBATCH(C[*])
4365 IF C[1] THEN GOSUB 9100
4370 IF NOT E THEN C[46]=C[46]+1
4375 DOEND
4380 DOEND
4385 RETURN
4400 REM1 <HEAD KEY>
4410 D1=C[27]=C[28]=C[46]=0
4420 RETURN
4450 REM1 <DELETE KEY>
4455 D1=0
4460 C[33]=1
4465 CALL VWRITEBATCH(C[*])
4470 IF C[1] THEN GOSUB 9100
4475 C[33]=0
4480 IF NOT E THEN C[46]=C[46]+1
4485 C[27]=C[28]=0
4490 RETURN
4500 REM1 <PRINT KEY>
4505 I=1
4510 J=49
4515 CALL VPRINTFORM(C[*],I,J)
4520 IF C[1] THEN GOSUB 9100
4525 RETURN
4550 REM1 <REFRESH KEY>
4560 RETURN
4600 REM1 <PREV KEY>
4610 D1=1
4620 C[46]=C[46]-1
4630 RETURN
4650 REM1 <NEXT KEY>
4655 D1=0
4660 C[46]=C[46]+1
4665 IF NOT C[27] AND C[28] OR C[27]=2 THEN DO
4670 CALL VSHOWFORM(C[*])
4675 IF C[1] THEN GOSUB 9100
4680 DOEND
4685 RETURN
5000 REM2 <EXIT>
5010 REM1 *CLOSE TERMINAL*
5020 CALL VCLOSETERM(C[*])
5030 IF C[1] THEN GOSUB 9000
5040 C[1]=0
5050 REM1 *CLOSE BATCH FILE*
5060 IF B1 THEN DO
5070 IF E THEN PRINT M1$
5080 ELSE DO
5090 CALL VCLOSEBATCH(C[*])
5100 IF C[1] THEN GOSUB 9100
5110 C[1]=0
5120 DOEND
5130 DOEND
5140 REM1 *CLOSE FORMS FILE*
5150 CALL VCLOSEFORMF(C[*])
5160 IF C[1] THEN GOSUB 9100
5170 C[1]=0
5180 RETURN
8000 REM2 <PRINT STATUS LINE>
8010 S$=" ENTRY "+V$+'27"&a31CBATCH RECORD # "
8020 CONVERT C[46]+1 TO S$[LEN(S$)+1]
8030 S$=S$+'27"&a65CMODE: "
8040 IF NOT C[5] THEN S$=S$+"COLLECT"
8050 ELSE S$=S$+'27"&dKBROWSE"
8060 I=LEN(S$)
8070 CALL VPUTWINDOW(C[*],S$,I)
8080 RETURN
8100 REM2 <GET FORM NAMES FROM COM ARRAY>
8110 B$=B1$=""
8120 FOR K=11 TO 18
8130 B$=B$+FNU$(C[K])
8140 B1$=B1$+FNU$(C[K+8])
8150 NEXT K
8160 B$=DEB$(B$[1,15])
8170 B1$=DEB$(B1$[1,15])
8180 RETURN
8200 REM2 <PUT NEXT FORM NAME IN COM ARRAY>
8210 B1$(LEN(B1$)+1,16] =""
8220 B1$[16,16]='0
8230 FOR K=1 TO 15 STEP 2
8240 C[INT(K/2)+19]=FNP(B1$[K;2])
8250 NEXT K
8260 RETURN
9000 REM2 <PRINT ERROR MESSAGE TO SCREEN>
9020 CALL VERRMSG(C[*],M$,W1,I)
9030 PRINT M$
9040 RETURN
9100 REM2 <PRINT VIEW ERROR MESSAGE TO DISPLAY WINDOW>
9105 IF E THEN RETURN
9110 E=1
9125 CALL VERRMSG(C[*],M$,W1,I)
9130 M$=" "+M$
9135 I=LEN(M$)
9140 C[1]=0
9145 CALL VPUTWINDOW(C[*],M$,I)
9150 RETURN
9200 REM2 <PRINT ENTRY ERROR MESSAGE TO DISPLAY WINDOW>
9210 IF E THEN RETURN
9220 E=1
9230 I=LEN(E$)
9240 CALL VPUTWINDOW(C[*],E$,I)
9250 RETURN
9900 REM2 ** TERMINATE **
9910 PRINT "END OF PROGRAM"
9920 END