
0010 REM DGWD3.0 'FULLINIT' C.DURRETT DOES FULL INITIALIZATION BASED ON PARAM 01/07/82
0100 DIM EXEMPT$[1000],MASFIL$[10],SUBFIL$[10],DIR$[10],FULNAM$[25]
0110 DIM PRMREC$[42],B$[512],BYTKEY$[1],DUPKEY$[1]
0120 ON IKEY THEN GOTO 3000
0121 LET DEBUG,AUTEXM,N,NEXMPT=0
0130 CLOSE 
0135 STMA 6,3
0140 STMA 9,1,DIR$
0200 PRINT @(-30);"FULL FILE INITIALIZATION -"
0210 PRINT "FULLY INITIALIZES DATA FILES DESCRIBED BY PARAM IN THIS DIRECTORY"
0220 PRINT "DATA WILL BE ERASED FROM ALL FILES NOT EXEMPTED"
0230 INPUT USING "","DO YOU WISH TO CONTINUE ? (YES/NO) ",B$
0240 LET B$[0]=FILL$(0)
0250 IF B$[1,3]="YES" THEN GOTO 1000 : OPEN PARAM AND GET PARTICULARS
0260 NEW 
1000 REM OPEN PARAM AND GET PARTICULARS
1005 LET CONTIG=0
1010 ON ERR THEN GOTO 1100
1020 OPEN FILE[0,0],"PARAM"
1030 ON ERR THEN INT
1040 GOSUB 1200 : GET EXEMPT LOGICAL FILE NAMES
1045 IF CONTIG THEN GOSUB 3200 : MAKE CONTIGUOUS FILES
1050 GOSUB 1300 : READ PARAM RECORD 0
1060 IF HIREC>0 THEN IF SUBFIL$[1,5]="PARAM" THEN IF MASFIL$[1,5]="PARAM" THEN IF STAT<>0 THEN GOTO 1090
1070 PRINT @(-25);"PARAM RECORD ZERO IS UNACCEPTABLE. ABORTING"
1080 NEW 
1090 LET MAXFIL=HIREC
1095 GOSUB 2000 : SET UP COMPLETE - GO TO WORK
1096 NEW 
1100 ON ERR THEN INT
1110 PRINT @(-25);"WARNING !!! PARAM FILE IN USE !!! ALL FILES MUST BE CLOSED."
1120 PRINT "ENSURE NO ONE IS RUNNING APPLICATIONS IN THIS DIRECTORY."
1130 DELAY 100
1140 GOTO 1000 : OPEN PARAM AND GET PARTICULARS
1200 REM GET EXEMPT LOGICAL FILE NAMES
1205 INPUT USING "","CREATE DATA FILES CONTIGOUSLY ? (Y/N):",@(-10,1),B$
1206 IF LEN(B$)=0 THEN GOTO 1205
1207 IF B$[1,1]<>"Y" THEN IF B$[1,1]<>"N" THEN GOTO 1205
1208 IF B$[1,1]="Y" THEN LET CONTIG=1
1210 GOSUB 5000 : OBTAIN/DISPLAY AUTO EXEMPT FILE NAMES
1220 FOR EXEMPT=AUTEXM TO 99
1225   PRINT USING "F2.0,Z",EXEMPT+1
1230   INPUT USING ""," ENTER EXEMPT LOGICAL FILE (CR WHEN DONE) ",SUBFIL$
1240   IF LEN(SUBFIL$)=0 THEN GOTO 1280
1250   LET SUBFIL$[0]=FILL$(0)
1260   LET EXEMPT$[EXEMPT*10+1]=SUBFIL$
1265 NEXT EXEMPT
1270 INPUT USING "","100 IS MAXIMUM NUMBER OF EXEMPT FILES.  DO YOU HAVE MORE? (Y/N): ",@(-10,1),B$
1272 ON POS("YN",B$,1)+1 THEN GOTO 1270, 1274, 1280
1274 PRINT "SORRY, THAT WAS A LOT OF TYPING FOR NOTHING!"
1275 NEW 
1280 LET EXEMPT$[0]=FILL$(0) \ NEXMPT=EXEMPT-1
1285 STMA 8,1
1290 RETURN 
1300 REM READ PARAM RECORD 0
1310 POSITION FILE[0,0]
1320 READ FILE[0],PRMREC$
1330 GOSUB 1400 : GET FIELDS FROM PARAM RECORD
1335 RETURN 
1400 REM GET FIELDS FROM PARAM RECORD
1410 LET STAT=ASC(PRMREC$[1,2])
1420 LET SUBFIL$=PRMREC$[3,12]
1430 LET MASFIL$=PRMREC$[13,22]
1440 LET SUBPOS=ASC(PRMREC$[23,26])
1450 LET RECLEN=ASC(PRMREC$[27,28])
1460 LET LSTREC=ASC(PRMREC$[29,32])
1470 LET HIREC=ASC(PRMREC$[33,36])
1480 LET BYTKEY$=PRMREC$[37,37]
1485 LET BYTKEY=ASC(BYTKEY$)
1490 LET DUPKEY$=PRMREC$[38,38]
1492 PRINT @(1,70);@(-32);SUBFIL$
1493 PRINT @(2,70);@(-32);MASFIL$
1494 FOR N=24 TO 21 STEP -1
1495   PRINT @(N,1);@(-32);
1496 NEXT N
1499 RETURN 
2000 REM SET UP COMPLETE - GO TO WORK
2010 GOSUB 2100 : READ NEXT PARAM RECORD$
2020 GOSUB 1400 : GET FIELDS FROM PARAM RECORD
2030 GOSUB 2200 : DETERMINE ELIGIBILITY
2040 IF ELIGBL=0 THEN GOTO 2010
2050 GOSUB 2300 : INIT SUBFIL$ IN MASFIL$
2060 GOTO 2010
2100 REM READ NEXT PARAM RECORD$
2110 READ FILE[0],PRMREC$
2115 IF EOF(0) THEN GOTO 1096
2120 RETURN 
2200 REM DETERMINE ELIGIBILITY
2205 LET ELIGBL=0
2206 IF STAT<>1 THEN GOTO 2290
2210 LET MASFIL$=TRUN$(MASFIL$,1)
2220 LET SUBFIL$=TRUN$(SUBFIL$,1)
2230 FOR EXEMPT=0 TO NEXMPT
2240   LET B$=TRUN$(EXEMPT$[EXEMPT*10+1,(EXEMPT+1)*10],1)
2250   IF LEN(B$)=0 THEN GOTO 2280
2260   IF B$=SUBFIL$ THEN GOTO 2290
2265   IF POS(B$,"-",1) THEN IF B$[1,POS(B$,"-",1)-1]=SUBFIL$[1,POS(B$,"-",1)-1] THEN GOTO 2290
2270 NEXT EXEMPT
2280 LET ELIGBL=1
2290 STMA 8,1
2295 RETURN 
2300 REM INIT SUBFIL$ IN MASFIL$
2310 ON SGN(BYTKEY)+1 THEN GOSUB 2400, 2600
2320 IF SGN(BYTKEY)+1=0 THEN PRINT SUBFIL$;" IN ";MASFIL$;" NOT INITIALIZED. BYTES/KEY WAS NEGATIVE. PARAM REC ";GPOS(0)/42-1
2330 RETURN 
2400 REM SUBFIL$ IS A DATA FILE
2410 ON ERR THEN GOTO 2510
2420 OPEN FILE[1,0],MASFIL$
2430 ON ERR THEN INT
2440 POSITION FILE[1,SUBPOS]
2450 LET STAT%=-2
2460 LET NXTAVL=-1
2470 LET LSTUSD=0
2480 WRITE FILE[1],STAT%,NXTAVL,LSTUSD,LSTUSD
2490 CLOSE FILE[1]
2500 RETURN 
2510 ON ERR THEN INT
2520 PRINT SUBFIL$;" NOT INITIALIZED - ";MASFIL$;" IN USE !"
2530 GOTO 2500
2600 REM SUBFIL$ IS AN INDEX FILE
2601 ON ERR THEN GOTO 2510
2602 OPEN FILE[1,0],MASFIL$
2603 ON ERR THEN INT
2604 IF MOD(SUBPOS,512) THEN GOSUB 2800 : ADJUSTING SUBPOS
2610 LET B$=FILL$(0)
2620 LET B$[1,2]=CHR$(BYTKEY+4,2)
2630 LET B$[3,4]=CHR$(((508/(BYTKEY+4))),2)
2640 LET B$[5,6]=CHR$(LSTREC,2)
2650 LET B$[7,8]=CHR$(2,2)
2660 LET B$[9,10]=CHR$(1,2)
2670 LET B$[11,12]=CHR$(ASC(B$[3,4])/2,2)
2680 IF DUPKEY$="Y" THEN LET B$[13,14]=CHR$(1,2)
2690 IF DUPKEY$<>"Y" THEN LET B$[13,14]=CHR$(0,2)
2700 LET B$[0]=FILL$(0)
2710 POSITION FILE[1,SUBPOS]
2720 WRITE FILE[1],B$[1,512]
2730 LET B$[1,2]=CHR$(1,2)
2750 LET B$[3]=FILL$(-1)
2760 POSITION FILE[1,SUBPOS+512]
2770 WRITE FILE[1],B$[1,512]
2780 CLOSE FILE[1]
2790 RETURN 
2800 REM ADJUSTING SUBPOS
2810 PRINT @(-25);"WARNING !! ";SUBFIL$;" DOES NOT START ON A SECTOR BOUNDARY WITHIN ";MASFIL$
2820 LET SUBPOS=SUBPOS+512-MOD(SUBPOS,512)
2830 POSITION FILE[0,GPOS(0)-42]
2840 PRINT @(-25);"       ADJUSTING PARAM ENTRY ";GPOS(0)/42;" FOR NEXT SECTOR BOUNDARY !"
2850 LET PRMREC$[23,26]=CHR$(SUBPOS,4)
2860 WRITE FILE[0],PRMREC$[1,42]
2870 RETURN 
3000 REM PROGRAM INTERRUPTED
3010 IF GPOS(0)<>-1 THEN GOTO 3100
3020 PRINT "FULL INITIALIZATION INTERRUPTED. NO FILES UPDATED."
3030 NEW 
3100 PRINT @(-25);"FULL INITIALIZATION INTERRUPTED. FILE(S) UPDATE INDETERMINATE."
3110 NEW 
3200 REM MAKE CONTIGUOUS FILES
3202 DIM T9$[544],Y$[18],KEY$[10],TSTFIL$[10]
3204 LET R1=0
3220 LET B$="FI$$",SYS(9),".IX"
3230 OPEN FILE[2,0],B$
3240 LET Y$=CHR$(2,2),FILL$(0)
3250 LET X=10
3260 LET Y=1
3270 LET Z=50
3280 LET X1=50
3290 GOSUB 7700 : \ INITINDEX
3300 GOSUB 1300 : READ PARAM RECORD 0
3310 LET MAXFIL=HIREC
3320 FOR I=1 TO MAXFIL
3330   READ FILE[0],PRMREC$
3340   IF EOF(0) THEN GOTO 3430
3350   GOSUB 1400 : GET FIELDS FROM PARAM RECORD
3360   IF STAT<1 THEN GOTO 3420
3370   LET R1=GPOS(0)/42-1
3380   LET KEY$=MASFIL$,FILL$(0)
3390   KADD Y$,T9$,KEY$,R1
3410   IF R1<1 THEN LET R1=R1/0
3420 NEXT I
3430 REM
3440 REM CALCULATE FILE SIZES
3445 LET SIZ=0
3446 LET ELIGBL=1
3450 LET KEY$=""
3455 LET TSTFIL$=""
3460 KFIND Y$,T9$,KEY$,R1
3470 LET R1=ABS(R1)
3480 IF R1<=0 THEN GOTO 3700 : OUT OF INDEX
3490 POSITION FILE[0,R1*42]
3500 READ FILE[0],PRMREC$
3510 GOSUB 1400 : GET FIELDS FROM PARAM RECORD
3520 IF LEN(TSTFIL$) THEN IF TSTFIL$<>MASFIL$ THEN GOTO 4200 : PHYSICAL FILE CHANGED
3530 LET BYTES=((SUBPOS+RECLEN*(LSTREC+1)+511)/512-1)*512
3540 IF BYTKEY<>0 THEN LET BYTES=((SUBPOS+RECLEN*(LSTREC))/512-1)*512
3550 LET SIZ=MAX(SIZ,BYTES)
3555 IF DEBUG THEN PRINT BYTES,SIZ,MASFIL$
3556 IF DEBUG THEN PRINT 
3560 LET TSTFIL$=MASFIL$
3570 GOSUB 2200 : DETERMINE ELIGIBILITY
3575 IF ELIGBL=0 THEN GOTO 4000 : INELIGIBLE LOGICAL FILE WITHIN PHYSICAL
3580 KNEXT Y$,T9$,KEY$,R1
3590 GOTO 3480
3700 REM OUT OF INDEX
3710 IF ELIGBL=0 THEN GOTO 4000 : INELIGIBLE LOGICAL FILE WITHIN PHYSICAL
3720 IF LEN(TSTFIL$)=0 THEN GOTO 3830
3730 IF SIZ=0 THEN GOTO 3830
3740 ON ERR THEN GOTO 3760
3750 DELETE MASFIL$
3760 ON ERR THEN INT
3780 LET FULNAM$=DIR$,":",MASFIL$,"<0>"
3785 REM CREATE FILE CONTIGUOUSLY
3790 LET E=0
3800 LET SIZ=SIZ/512+1
3805 IF DEBUG THEN PRINT SIZ,SIZ*512
3806 IF DEBUG THEN PRINT FULNAM$
3807 IF DEBUG THEN PRINT 
3810 STMC 0,E,FULNAM$,SIZ
3815 IF DEBUG THEN PRINT SIZ
3820 IF E<>-1 THEN GOTO 3850 : CONTIGUOUS CREATE ERROR
3830 RETURN 
3850 REM CONTIGUOUS CREATE ERROR
3860 IF E=1 THEN PRINT "ILLEGAL FILE NAME ";
3865 IF E=9 THEN PRINT "UNABLE TO DELETE ";
3870 IF E=23 THEN PRINT "INSUFFICIENT DIRECTORY SPACE ";
3875 IF E=38 THEN PRINT "INSUFFICIENT BLOCKS (";SIZ;") ";
3880 IF E=43 THEN PRINT "DIRECTORY UNKNOWN ";
3885 IF E=47 THEN PRINT "LINK DEPTH EXCEEDED ";
3890 IF E=54 THEN PRINT "DIRECTORY NOT INITIALIZED ";
3895 IF E=65 THEN PRINT "WARNING ! DISK NOT READY ";
3900 PRINT "FILE ";FULNAM$
3901 PRINT 
3905 RETURN 
4000 REM INELIGIBLE LOGICAL FILE WITHIN PHYSICAL
4010 LET MASFIL$=TRUN$(MASFIL$,1)
4020 LET SUBFIL$=TRUN$(SUBFIL$,1)
4030 PRINT @(-25);SUBFIL$;" EXEMPTED - ";MASFIL$;" NOT CONTIGUOUSLY CREATED"
4032 LET MASFIL$[0]=FILL$(0)
4034 LET SUBFIL$[0]=FILL$(0)
4040 KNEXT Y$,T9$,KEY$,R1
4050 IF R1<=0 THEN GOTO 3830
4060 POSITION FILE[0,R1*42]
4070 READ FILE[0],PRMREC$
4080 GOSUB 1400 : GET FIELDS FROM PARAM RECORD
4085 IF DEBUG THEN PRINT "***************************";TSTFIL$
4086 IF DEBUG THEN PRINT 
4087 IF DEBUG THEN PRINT "                                      ";MASFIL$
4088 IF DEBUG THEN PRINT 
4090 IF MASFIL$<>TSTFIL$ THEN GOTO 4110 : KEYS SKIPPED FOR PHYSICAL FILE
4100 GOTO 4040
4110 REM KEYS SKIPPED FOR PHYSICAL FILE
4120 LET SIZ=0
4130 GOTO 3530
4200 REM PHYSICAL FILE CHANGED
4206 LET FULNAM$=DIR$,":",TSTFIL$,"<0>"
4207 ON ERR THEN GOTO 4209
4208 DELETE TSTFIL$
4209 ON ERR THEN INT
4210 GOSUB 3785 : CREATE FILE CONTIGUOUSLY
4220 LET SIZ=0
4230 GOTO 3530
4935 IF MASFIL$<>TSTFIL$ THEN GOTO 4110 : KEYS SKIPPED FOR PHYSICAL FILE
5000 REM OBTAIN/DISPLAY AUTO EXEMPT FILE NAMES
5010 DATA "ARKP-","FKPROGX.IX","FKPROGX.DT","KPROGX","KPROGX.IX"
5015 DATA "TAG-","TRANDSC"
5020 DATA "ZZZZZZZZZZ"
5030 RESTORE 5000 : OBTAIN/DISPLAY AUTO EXEMPT FILE NAMES
5040 LET EXEMPT$=FILL$(0) \ AUTEXM,N=0
5050 READ SUBFIL$
5060 IF SUBFIL$="ZZZZZZZZZZ" THEN GOTO 5100 : DISPLAY
5070 LET SUBFIL$[0]=FILL$(0) \ EXEMPT$[AUTEXM*10+1]=SUBFIL$ \ AUTEXM=AUTEXM+1
5080 GOTO 5050
5100 REM DISPLAY
5110 PRINT "<10>FILES AUTOMATICALLY EXEMPTED:"
5120 FOR EXEMPT=0 TO AUTEXM-1
5125   PRINT USING "F2.0,X,A12,Z",EXEMPT+1,EXEMPT$[EXEMPT*10+1,EXEMPT*10+10]
5130   IF EXEMPT=AUTEXM-1 THEN GOTO 5145
5135   LET N=N+1
5140   IF N<5 THEN GOTO 5155
5145   PRINT 
5150   LET N=0
5155 NEXT EXEMPT
5160 PRINT "<10>ENTER OTHER LOGICAL FILES TO EXEMPT."
5170 PRINT "NOTE: 'XYZ-' MEANS EXEMPT ALL LOGICAL FILES STARTING WITH 'XYZ'.<10>"
5180 RETURN 
7700 REM \ INITINDEX
7705 LET Y1=ASC(Y$[3,6])
7710 IF ASC(Y$[7,8])=0 THEN LOCK 32767,Y$[9,18],0,512
7720 LET Z1=ASC(Y$[1,2])
7730 POSITION FILE[Z1,Y1]
7740 WRITE FILE[Z1],SHFT(X+4,16)+508/(X+4),SHFT(X1-1,16)+2,65536+508/(X+4)*Z/100,SHFT(Y,16)
7750 LET T9$=CHR$(1,2),FILL$(-1,510)
7760 POSITION FILE[Z1,Y1+512]
7770 WRITE FILE[Z1],T9$
7780 UNLOCK 32767
7790 RETURN 
7799 REM * END INITINDEX 10/27/77
9999 REPLACE "FULLINIT"

) type addmenu.ba
0010 REM THIS IS A MENU PROGRAM
0020 DATA 4
0040 DATA "BLM FILE INPUT MENU"
0101 DATA "LOCATION MASTER FILE                    ","LOCATEADD    ","                                        "
0102 DATA "ITEM LOCATION FILE                      ","FIBLOCADD    ","                                        "
0103 DATA "CUSTOMER MASTER FILE                    ","CUSTADD      ","                                        "
0104 DATA "END                                     ","END          ","                                        "
0200 REM
0280 ON IKEY THEN GOTO 0300
0285 ON ERR THEN GOTO 2000
0300 REM THIS SECTION OF CODE INITIALIZES VALUES
0305 RESTORE 
0310 REM MAXIMUM # OF PROMPTS IS 16
0315 LET MPRMPT=16
0320 REM WIDTH OF SCREEN IS ASSUMED 72 FOR CENTERING HEADING
0325 LET WIDMAX=72
0330 REM LENGTH OF EACH PROMPT IS 40
0335 LET LPRMPT=40
0340 REM LENGTH OF EACH SWAP FILE IS 13
0345 LET LSWP=13
0350 REM LENGTH OF INFORMATION PASSED TO COMMON IS 40
0355 LET LCM=40
0380 DIM HEAD$[WIDMAX],PRMPT$[MPRMPT*LPRMPT],SWP$[MPRMPT*LSWP],CM$[MPRMPT*LCM]
0385 DIM CORR$[2*MPRMPT],WHICH$[LSWP],D$[MAX(LPRMPT,LCM)],X$[512]
0400 REM THIS SECTION READS INTO ELE,HEAD$,PRMPT$,SWP$
0405 READ ELE,HEAD$
0410 FOR I=1 TO ELE
0412   READ D$
0415   LET PRMPT$[(I-1)*LPRMPT+1,I*LPRMPT]=D$,FILL$(32)
0432   READ D$
0435   LET SWP$[(I-1)*LSWP+1,I*LSWP]=D$,FILL$(32)
0437   READ D$
0442   LET CM$[(I-1)*LCM+1,I*LCM]=D$,FILL$(32)
0445 NEXT I
0450 REM THIS SECTION DISPLAYS THE MENU
0451 CLOSE 
0452 STMA 8,0
0455 PRINT @(-30);
0460 REM CENTER HEADING ON SCREEN
0470 PRINT @(2,(WIDMAX-LEN(HEAD$)+1)/2);HEAD$
0480 LET YPOS=4
0490 LET COUNT=0
0495 LET PROG=0
0497 REM OUTPUT PROMPTS FOR PROGRAM SELECTION
0500 LET COUNT=COUNT+1
0505 LET IND1=0
0510 IF SWP$[(COUNT-1)*LSWP+1,COUNT*LSWP]="             " THEN LET IND1=1
0513 IF IND1=1 THEN GOTO 0540
0515 LET PROG=PROG+1
0520 LET CORR$[(PROG-1)*2+1,PROG*2]=CHR$(COUNT,2)
0530 PRINT @(YPOS,10);
0535 PRINT USING "('XX.',L7X,T0,D3.0,Z)",PROG
0540 PRINT @(YPOS,15);
0550 PRINT PRMPT$[(COUNT-1)*LPRMPT+1,COUNT*LPRMPT];
0551 IF IND1=1 THEN GOTO 0555
0553 PRINT @(YPOS,57);
0554 PRINT USING "('(',A13,')'),Z",SWP$[(COUNT-1)*LSWP+1,COUNT*LSWP]
0555 PRINT 
0556 IF COUNT=ELE THEN GOTO 0575 : THIS SECTION ACCEPTS DESIRED OPTION
0557 REM THIS ALLOWS DOUBLE SPACING
0560 IF ELE<10 THEN LET YPOS=YPOS+1
0565 LET YPOS=YPOS+1
0570 GOTO 0500
0575 REM THIS SECTION ACCEPTS DESIRED OPTION
0580 PRINT @(22,15);
0590 ON ERR THEN GOTO 0640
0595 INPUT USING "","ENTER DESIRED OPTION : ",@(-10,2),P
0600 ON ERR THEN GOTO 2000
0630 IF P<PROG+1 THEN IF P>0 THEN GOTO 0675
0635 REM ERROR IN SELECTION OF ITEM FROM MENU
0640 PRINT @(22,42);
0645 PRINT "ERROR, TRY AGAIN"
0650 GOTO 0575 : THIS SECTION ACCEPTS DESIRED OPTION
0670 REM THIS SECTION SWAPS TO THE CORRECT PROGRAM
0675 PRINT @(-30);
0680 IF P=ELE THEN GOTO 0800
0685 LET P=ASC(CORR$[(P-1)*2+1,P*2])
0690 LET WHICH$=SWP$[(P-1)*LSWP+1,P*LSWP]
0692 LET X$=CM$[(P-1)*LCM+1,P*LCM],FILL$(32)
0695 BLOCK WRITE X$
0700 SWAP WHICH$
0705 GOTO 0450 : THIS SECTION DISPLAYS THE MENU
0800 END 
2000 REM ERROR SUBROUTINE
2002 ON ERR THEN INT
2003 DIM X$[72]
2004 LET X$=ERM$(SYS(7))
2005 PRINT @(-25);@(23,1);"ERROR AT STM# ";SYS(20);". ";X$
2010 INPUT USING "","HIT RETURN TO ACKNOWLEDGE.",@(-10,1),X$[1,1]
2015 END 

) 
