100 ON ERROR GOTO ERR'CODE
120 STRSIZ 100
140 !
160 ! PROGRAM NAME: LETTER.BAS
180 !
200 ! FUNCTION: THIS PROGRAM COPIES A LETTER FILE TO THE PRINTER OR TO A
220 ! SPOOL FILE, WHILE DOING SUBSTITUTIONS FOR VARIABLES EMBEDDED
240 ! IN THE TEXT. THE DATA FOR THESE SUBSTITUTIONS MAY COME EITHER
260 ! FROM THE TERMINAL OR FROM A FILE. A VARIABLE IS DENOTED BY
280 ! LEADING AND TRAILING BACKSLASHES. IN ORDER TO INSERT A
300 ! BACKSLASH AS TEXT, TWO BACKSLASHES MUST BE TYPED. THE
320 ! INPUT FILE MAY CONTAIN PAGE BREAKS, IN WHICH CASE THE FF
340 ! MUST BE THE FIRST CHARACTER IN THE LINE, OR THEY MAY BE
360 ! GENERATED BY THIS PROGRAM.
380 !
400 ! AUTHOR: TOM DAHLQUIST
420 !
440 ! DATE REVISION
460 ! 11/21/79 CHANGED EXIT PROCEDURE TO CHAIN TO "DSK0:LTREXT.CMD[2,2]"
480 ! ADDED ABILITY TO SPECIFY LINES/PAGE FOR NONSTANDARD FORMS
500 ! ADDED DEFAULT AND ABILITY TO SPECIFY OUTPUT TO OTHER PRINTERS
520 !
540 MAP1 COPYRIGHT,S,47,"COPYRIGHT 1979, DATA PROCESSING CONSULTING, INC"
560 ! THIS PROGRAM IS THE SOLE PROPERTY OF DATA PROCESSING CONSULTING, INC.
580 ! EXCEPT FOR THE PURPOSE OF USE AT THE INSTALLATION TO WHICH IT WAS
600 ! SOLD, IT MAY NOT BE REPRODUCED IN ANY WAY WITHOUT THE EXPRESS WRITTEN
620 ! PERMISSION OF DPCI.
640 !
660 ! WORKING STORAGE
680 !
700 MAP1 ISTG,S,132
720 MAP1 OSTG,S,132
740 MAP1 OSTG'S(132),S,1,@OSTG
760 MAP1 LFILE(15),S,24
780 MAP1 VAR'NAME,S,50
800 MAP1 DFLT,S,24,"TRM1:ANDY"
820 MAP1 DLUSE,S,15,"$$##,###,###.##"
840 MAP1 DAT,B,4
860 MAP1 DTE,@DAT
880 MAP2 M,B,1
900 MAP2 D,B,1
920 MAP2 Y,B,1
940 MAP2 DFILL,B,1
960 MAP1 BLKTAB,S,2
980 MAP1 NOSPECS,F,,2
1000 MAP1 SPECS(2),S,12
1020 MAP1 MOTAB(12),S,9
1040 !
1060 BLKTAB=" "+CHR(9)
1080 FOR I=1 TO 12:READ MOTAB(I):NEXT
1100 DATA January,February,March,April,May,June
1120 DATA July,August,September,October,November,December
1140 FOR I=1 TO 2:READ SPECS(I):NEXT
1160 DATA DATEA,DATEB
1180 !
1200 ! INITIALIZATION
1220 !
1240 GET'FILE: INPUT LINE "First Text File Name: ";A$
1260 A$=UCS(A$)
1280 C$=".TXT" : GOSUB DEFAULT : LFILE(1)=A$
1300 FILENUM=1
1320 OPEN #1,LFILE(1),INPUT
1340 CLOSE #1
1360 INFILES=2
1380 FILENUM=2
1400 GET'PARAS: INPUT LINE "Next Text File (Or RETURN): ";A$
1420 A$=UCS(A$)
1440 IF A$="" THEN INFILES=INFILES-1 : GOTO GET'OUT
1460 GOSUB DEFAULT : LFILE(INFILES)=A$
1480 OPEN #1,LFILE(INFILES),INPUT
1500 CLOSE #1
1520 INFILES=INFILES+1
1540 GOTO GET'PARAS
1560 GET'OUT: ?"Enter Output File Name Or Hit RETURN"
1580 ?"For Output To Word Processing Printer: ";
1600 INPUT LINE A$
1620 A$=UCS(A$)
1640 FILENUM=3
1660 IF A$="" THEN A$=DFLT
1680 IF A$[1,3]="TRM" THEN OUTTRM=-1 : GOTO OPEN'OUT
1700 C$=".LST" : GOSUB DEFAULT : FORMS=1 : FFLAG=-1
1720 ! FOR OUTPUT TO A FILE, FORCE CONTINUOUS AND SKIP ALIGNMENT OF FIRST PAGE
1740 OPEN'OUT: OFILE$=A$
1760 OPEN #2,OFILE$,OUTPUT
1780 GET'LINES: INPUT "Lines Per Page (Or RETURN): ";LINES
1800 IF LINES=0 THEN ?"*** No Page Break Generation ***"
1820 GET'PHYS: ?"Hit RETURN For Standard Length Forms Or"
1840 ?"Enter Lines Per Page For Nonstandard Forms: ";
1860 INPUT LINE PHYS'LINES
1880 IF PHYS'LINES=0 OR PHYS'LINES>=LINES GOTO GET'FORMS
1900 ?"Sorry, Forms Length Must Be GREATER Than Lines Per Page"
1920 GOTO GET'LINES
1940 GET'FORMS: IF FORMS#0 GOTO GET'DFILE
1960 INPUT "Continuous Or Single Forms--C/S: ";A$
1980 FORMS=INSTR(1,"CS",UCS(A$)) : IF FORMS=0 GOTO GET'FORMS
2000 GET'DFILE: ?"Enter T For Data Input From Terminal"
2020 ?" F For Data Input From A File"
2040 ?" N For No Data Input (Backslashes Ignored)"
2060 INPUT A$
2080 I=INSTR(1,"TFN",UCS(A$))
2100 ON I GOTO TERMIN,GET'DNAME,NODATA
2120 GOTO GET'DFILE
2140 TERMIN:
2160 DF=1
2180 GOTO BEGIN
2200 GET'DNAME: INPUT LINE "Data File Name: ",A$
2220 A$=UCS(A$)
2240 IF A$="" THEN GOTO GET'DNAME
2260 DF=2
2280 C$=".DAT" : GOSUB DEFAULT : DFILE$=A$
2300 FILENUM=4
2320 OPEN #3,DFILE$,INPUT
2340 INPUT LINE #3,D$
2360 GOTO BEGIN
2380 NODATA:
2400 DF=1
2420 BFLAG=-1
2440 GET'COPIES: A$=""
2460 INPUT "Number Of Copies (Or RETURN): ";A$
2480 IF A$="" THEN ?"*** Hit CONTROL-C To End Execution ***" : GOTO BEGIN
2500 COPIES=A$
2520 IF COPIES=0 GOTO GET'COPIES
2540 !
2560 ! BEGIN LOOP THROUGH ENTIRE LETTER
2580 !
2600 BEGIN: NCOPIES=NCOPIES+1
2620 ON FORMS GOTO TEST'F,BEGIN'S
2640 TEST'F: IF FFLAG GOTO BEGIN'C
2660 BEGIN'S: INPUT "Hit RETURN When First Page Ready: ";A$
2680 FFLAG=-1
2700 BEGIN'C: IF COPIES<>0 THEN ?"*** Printing Copy #";NCOPIES
2720 INFILE=1
2740 OPEN #1,LFILE(1),INPUT
2760 INPUT LINE #1,ISTG ! GET RID OF FIRST FF IF PRESENT
2780 IF EOF(1)=1 GOTO ENDFILE
2800 IF ASC(ISTG[1;1])=12 THEN ISTG=RIGHT(ISTG,LEN(ISTG)-1)
2820 GOTO NO'FF
2840 !
2860 ! LOOP THROUGH INPUT FILE
2880 !
2900 LOOP: INPUT LINE #1,ISTG
2920 IF EOF(1)=1 GOTO ENDFILE
2940 IF LINES <>0 THEN GOTO NO'FF ! SKIP IF NOT CHECKING FOR FF
2960 ON FORMS GOTO NO'FF,CHK'FF ! SKIP IF CONTINUOUS FORMS
2980 CHK'FF: IF ASC(ISTG[1;1])<>12 GOTO NO'FF ! SKIP IF FIRST CHAR NOT FF
3000 ISTG=RIGHT(ISTG,LEN(ISTG)-1)
3020 GOSUB NEXT'S
3040 NO'FF: IF BFLAG THEN ?#2,ISTG : GOTO CHK'LINES
3060 K=LEN(ISTG)
3080 BEG=1
3100 VFLAG=0
3120 !
3140 ! BEGIN LOOP THROUGH SINGLE RECORD
3160 !
3180 IN'LOOP: IF BEG>K GOTO LOOP'END
3200 I=INSTR(BEG,ISTG,"\")
3220 IF I=0 GOTO NO'MORE
3240 J=INSTR(I+1,ISTG,"\")
3260 IF J=0 GOTO BAD'FILE
3280 IF J=I+1 GOTO B'SLASH
3300 IF EOF(3)=1 GOTO D'ENDFILE
3320 VFLAG=-1
3340 VAR'NAME=ISTG[I+1,J-1]
3360 JUMP=INSTR(1,"*$",LEFT(VAR'NAME,1)) ! SEE IF SPECIAL PROCESSING--
3380 IF JUMP=0 GOTO NORMAL
3390 VAR'NAME=VAR'NAME[2,-1]
3400 !
3420 ! SPECIAL CONTROL VARIABLES OR TYPES PROCESSED HERE
3440 !
3460 ON JUMP GOTO SPECIAL,DOLLAR
3480 !
3500 SPECIAL:
3520 VAR'NAME=UCS(VAR'NAME)
3540 FOR TEMP1=1 TO NOSPECS
3560 IF VAR'NAME#SPECS(TEMP1) GOTO SPNEXT
3580 JUMP=TEMP1 : TEMP1=NOSPECS : NEXT TEMP1 : GOTO SPECJUMP
3600 SPNEXT: NEXT TEMP1
3620 ?"*** ERROR: Special Function Name ";VAR'NAME;" Not In Table ***"
3630 INPUT LINE "*** Hit RETURN To Continue: "XXX$
3640 GOTO CHAINOUT
3660 SPECJUMP:
3680 ON JUMP GOTO SPEC1,SPEC2
3700 !
3720 SPEC1: ! DATE AS MONTH DD,19YY
3740 IF DATE=0 GOSUB GET'DATE
3760 DAT=DATE
3780 SP$=MOTAB(M)+" "+D+",19"+Y
3800 GOTO USESPEC
3820 !
3840 SPEC2: ! DATE AS MM/DD/YY
3860 IF DATE=0 GOSUB GET'DATE
3880 DAT=DATE
3900 SP$=(M USING "#Z")+"/"+(D USING "#Z")+"/"+Y
3920 GOTO USESPEC
3940 !
3960 USESPEC:
3980 OSTG=OSTG+ISTG[BEG;I-BEG]+SP$
4000 GOTO IN'LOOP'END
4020 !
4040 DOLLAR:
4060 DFLAG=-1
4080 GOTO NORMAL
4100 !
4120 ! NORMAL VARIABLES PROCESSED HERE
4140 !
4160 NORMAL:
4180 ON DF GOTO FROM'TERM,GOT'DATA
4200 FROM'TERM: IF UCS(VAR'NAME)#"SKIP" THEN ?VAR'NAME+": "; :INPUT LINE D$
4220 GOT'DATA: IF UCS(VAR'NAME)="SKIP" THEN D$=""
4240 IF NOT DFLAG GOTO NOEDIT
4260 D$=D$ USING DLUSE
4280 D$=D$[INSTR(1,D$,"$"),-1]
4300 IF RIGHT(D$,3)=".00" THEN D$=D$[1,-4]
4320 DFLAG=0
4340 NOEDIT:
4360 OSTG=OSTG+ISTG[BEG;I-BEG]+D$
4380 ON DF GOTO IN'LOOP'END,NEXT'D
4400 NEXT'D: INPUT LINE #3,D$
4420 GOTO IN'LOOP'END
4440 B'SLASH: OSTG=OSTG+ISTG[BEG;I-BEG]+"\"
4460 IN'LOOP'END: BEG=J+1
4480 GOTO IN'LOOP
4500 !
4520 ! END OF SINGLE RECORD LOOP
4540 !
4560 NO'MORE: OSTG=OSTG+ISTG[BEG,K]
4580 LOOP'END: IF NOT VFLAG GOTO PRT'IT
4582 TEMP1=LEN(OSTG) ! DETERMINE IF LINE SHOULD BE SKIPPED--
4583 IF TEMP1=0 GOTO LOOP
4584 FOR TEMP2=1 TO TEMP1
4586 IF INSTR(1,BLKTAB,OSTG'S(TEMP2))=0 THEN TEMP2=TEMP1 : NEXT TEMP2 : GOTO PRT'IT
4588 NEXT TEMP2
4590 OSTG="" : GOTO LOOP
4592 PRT'IT:
4600 ?#2,OSTG
4620 OSTG=""
4640 CHK'LINES: IF LINES=0 GOTO LOOP
4660 OLINES=OLINES+1
4680 IF OLINES<LINES GOTO LOOP
4690 ON FORMS GOSUB FORM'FEED,NEXT'S
4700 OLINES=0
4760 GOTO LOOP
4780 PAGE'S: GOSUB NEXT'S
4800 GOTO LOOP
4820 !
4840 ! END OF LOOP THROUGH INPUT FILE
4860 !
4880 !
4900 ! END-OF-FILE CODE
4920 !
4940 ENDFILE: IF INFILE=INFILES GOTO REAL'END
4960 CLOSE #1
4980 INFILE=INFILE+1
5000 OPEN #1,LFILE(INFILE),INPUT
5020 GOTO LOOP
5040 REAL'END: GOSUB FORM'FEED
5060 OLINES=0
5080 ON DF GOTO END'TERM,END'FILE
5100 END'TERM: IF OUTTRM THEN CLOSE #2
5120 IF NOT BFLAG GOTO ASK'RESTART
5140 IF COPIES=0 GOTO REOPEN
5160 IF NCOPIES<COPIES THEN GOTO REOPEN ELSE GOTO CHAINOUT
5180 ASK'RESTART: ?"End Of Letter: Type 'R' To Restart, Hit RETURN To End: ";
5200 INPUT LINE A$
5220 IF A$#"" GOTO REOPEN
5240 IF NOT OUTTRM THEN CLOSE #2
5260 GOTO CHAINOUT
5280 REOPEN: IF OUTTRM THEN OPEN #2,OFILE$,OUTPUT
5300 GOTO RESTART
5320 END'FILE: IF EOF(3)=1 GOTO D'ENDFILE
5340 ON FORMS GOTO RESTART,CLOSOPEN
5360 CLOSOPEN: CLOSE #2
5380 OPEN #2,OFILE$,OUTPUT
5400 RESTART: CLOSE #1
5420 GOTO BEGIN
5440 !
5460 ! END-OF-FILE ON DATA
5480 !
5500 D'ENDFILE: ?"*** End Of Data ***"
5520 CLOSE #2 : GOTO CHAINOUT
5540 !
5560 ! SUBROUTINE TO ASK FOR NEXT PAGE
5580 !
5600 NEXT'S: GOSUB FORM'FEED ! SHOOT THIS PAGE OUT
5620 CLOSE #2
5640 OPEN #2,OFILE$,OUTPUT
5660 INPUT "Insert Next Page; Hit RETURN When Ready: ",A$
5680 RETURN
5700 !
5720 ! EXTENSION DEFAULT ROUTINE--A$ IS INPUT, C$ IS DEFAULT EXTENSION
5740 !
5760 DEFAULT: IF INSTR(1,A$,".")<>0 RETURN
5780 I=INSTR(1,A$,"[")
5800 IF I=0 THEN A$=A$+C$ : RETURN
5820 A$=LEFT(A$,I-1)+C$+RIGHT(A$,LEN(A$)-I+1)
5840 RETURN
5860 !
5880 ! FORMFEED ROUTINE
5900 !
5920 FORM'FEED: IF PHYS'LINES=0 THEN ?#2,CHR(12);SPACE(46);CHR(13); : RETURN
5940 FOR I=1 TO PHYS'LINES-OLINES
5960 ?#2
5980 NEXT I
6000 RETURN
6020 !
6040 ! GET TODAY'S DATE
6060 !
6080 GET'DATE:
6100 ?"System Date Is Not Set--"
6120 ASK'DATE: INPUT LINE "Please Enter As MMDDYY: "DT$
6140 IF LEN(DT$)#6 GOTO ASK'DATE
6160 M=DT$[1,2] : D=DT$[3,4] : Y=DT$[5,6]
6180 DATE=DAT
6200 RETURN
6220 !
6240 ! ON ERROR ROUTINE
6260 !
6280 ERR'CODE: IF ERR(0)=1 THEN RESUME QUIT
6300 IF ERR(0)<>17 GOTO CHK'SPEC
6320 ?"*** FILE NOT FOUND ***"
6340 RESUME RETRY
6360 CHK'SPEC: IF ERR(0)<>16 GOTO CHK'DEVRDY
6380 ?"*** FILE SPECIFICATION ERROR ***"
6400 RESUME RETRY
6420 CHK'DEVRDY: IF ERR(0)<>18 GOTO CHK'DEVFLL
6440 ?"*** DEVICE NOT READY ***"
6460 RESUME RETRY
6480 CHK'DEVFLL: IF ERR(0)<>19 GOTO CHK'DEVERR
6500 ?"*** DEVICE FULL ***"
6520 RESUME RETRY
6540 CHK'DEVERR: IF ERR(0)<>20 GOTO CHK'CODE
6560 ?"*** DEVICE ERROR ***"
6580 RESUME RETRY
6600 CHK'CODE: IF ERR(0)<>22 GOTO CHK'PROT
6620 ?"*** ILLEGAL USER CODE ***"
6640 RESUME RETRY
6660 CHK'PROT: IF ERR(0)<>23 GOTO CHK'WRIT
6680 ?"*** PROTECTION VIOLATION ***"
6700 RESUME RETRY
6720 CHK'WRIT: IF ERR(0)<>24 GOTO CHK'TYPE
6740 ?"*** WRITE PROTECTED ***"
6760 RESUME RETRY
6780 CHK'TYPE: IF ERR(0)<>25 GOTO CHK'DEV
6800 ?"*** NOT A SEQUENTIAL FILE ***"
6820 RESUME RETRY
6840 CHK'DEV: IF ERR(0)<>26 GOTO CHK'BIT
6860 ?"*** DEVICE DOES NOT EXIST ***"
6880 RESUME RETRY
6900 CHK'BIT: IF ERR(0)<>27 GOTO CHK'MNT
6920 ?"*** BITMAP DESTROYED ***"
6940 RESUME QUIT
6960 CHK'MNT: IF ERR(0)<>28 GOTO DIE
6980 ?"*** DISK NOT MOUNTED ***"
7000 RESUME RETRY
7020 DIE: ?"*** ERROR: CODE=";ERR(0);" LINE=";ERR(1);" LASTFILE=";ERR(2)
7040 ?"*** UNABLE TO CONTINUE"
7060 QUIT: ON ERROR GOTO 0
7080 GOTO CHAINOUT
7100 RETRY: ON FILENUM GOTO GET'FILE,GET'PARAS,GET'OUT,GET'DNAME
7120 !
7140 ! UNPAIRED BACKSLASH ERROR
7160 !
7180 BAD'FILE: ?"*** ERROR IN INPUT FILE: UNPAIRED BACKSLASH FOUND"
7200 ?"*** BAD RECORD FOLLOWS:"
7220 ?ISTG
7240 CHAINOUT: CHAIN "DSK0:LTREXT.CMD[2,2]"
