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]"