File LEDIT.QS

Directory of image this file is from
This file as a plain text file

START	;NAME & ADDRESS LABEL FILE EDITOR
INCLUDE (01,NAMFIL,RS)
RECORD KBREC,C
	KB,	A35		;KEYBOARD BUFFER
RECORD KBDUM,C					;DUMMY REC FOR XMIT
	,A1
RECORD
	KBD,	D3		;KEYBOARD INPUT DELIMITER
	RECNO,	D3		;NAMFIL RECORD NUMBER
	CCNT,	D2		;COUNTER FOR LOOPS
	EDITSW,	D1		;SWITCH =1 AFTER GOOD INPUT EDIT
PROC	;EDIT PROCEDURE
	OPEN ('160107NAMFILDT')		;OPEN FILE FOR INPUT
NEXTREC,	DISPLAY(1,1,1)		;CLEAR SCREEN
	DISPLAY(2,1,'RECORD NUMBER  ')
	CALL INNUM			;GET AND CHECK INPUT
					;NUMBER OR 'EXIT' VALID
	IF (EDITSW.NE.1) GOTO NEXTREC
	RECNO= KB(1,3)			;FIX RECORD NUMBER
	READ(01,NAMFIL,RECNO)		;GET RECORD
	DISPLAY(5,10,FNAME)
	DISPLAY(5,23,LNAME)
	DISPLAY(6,10,ADDR1)
	DISPLAY(7,10,ADDR2)
	DISPLAY(8,10,ADDR3)
	DISPLAY(8,25,STATE)
	KB(1,5) = ZIP
	DISPLAY(8,28,KB(1,5))
	DISPLAY(10,5,'TELEPHONE')
	KB(1,12) = TEL, 'XXX-XXX-XXXX'		;FORMAT TEL NUMBER
	DISPLAY(10,15,KB(1,12))
	DISPLAY(10,29,'BIRTHDAY')
	KB(1,8) = BDAY, 'XX/XX/XX'
	DISPLAY(10,39,KB(1,8))
	SPACE 1
	DISPLAY(12,1,'ANY CHANGES? ')
	CALL INALPH				;GET INPUT ROUTINE
	IF (KB(1,1).NE.'Y') GOTO NEXTREC	;GET NEXT RECORD IF NO CHANGE
SPACE 2
FIXREC,	XMIT(8," ENTER NEW LINE OR <LF> FOR NO CHANGE')
	 KB=FNAME
	XMIT(8,KBREC)			;SHOW ORIG FIRST NAME
	CALL INALPH
	 IF (EDITSW=1) FNAME = KB
	 KB=LNAME
	XMIT(8,KBREC)			;SHOW ORIG LAST NAME
	 CALL INALPH
	 IF (EDITSW=1) LNAME = KB
	 KB=ADDR1
	XMIT(8,KBREC)			;SHOW ORIG. ADDRESS LINE 1
	 CALL INALPH
	 IF (EDITSW=1) ADDR1 = KB
	 KB=ADDR2
	XMIT(8,KBREC)			;SHOW ORIG ADDRESS 2
	 CALL INALPH
	 IF (EDITSW=1) ADDR2 = KB
	 KB=ADDR3
	XMIT(8,KBREC)			;SHOW ORIG ADDRESS 3
	 CALL INALPH
	 IF (EDITSW=1) ADDR3 = KB
	 KB=STATE
	XMIT(8,KBREC)
	 CALL INALPH
	 IF (EDITSW=1) STATE = KB
	KB=
	 KB(1,5)=ZIP
	XMIT(8,KBREC)
	 CALL INNUM
	 IF (EDITSW=1) ZIP = KB
	 KB(1,12)=TEL, 'XXX-XXX-XXXX'
	XMIT(8,KBREC)
	 CALL INNUM
	 IF (EDITSW=1) TEL = KB
	KB=
	 KB(1,6)=BDAY
	XMIT(8,KBREC)
	 CALL INNUM
	 IF (EDITSW=1) BDAY = KB
	XMIT (8,"CONFIRM? ')			;DATA COMPLETE ASK IF OK
	 CALL INALPH
	 IF (KB(1,1).NE.'Y')  GOTO FIXREC		;REPEAT IF NOT OK
	WRITE(01,NAMFIL,RECNO)			;DO THE WRITE  FINALY
	GOTO NEXTREC
SPACE 2
EXIT,	FINI(01)				;CLOSE NAMFIL
	XMIT(8,"  END OF JOB')
	STOP
SPACE 2
INALPH,					;READ ALPHABETIC ROUTINE
	KB=					;CLEAR KB BUFFER
	ACCEPT(KBD,KB)
	EDITSW=1
	CCNT=0
	IF (KBD = 10) GOTO INALP2		;CHECK FOR <LF>
 INALP1,					;COULD LOOP HERE TO CHECK CHARS.
	XMIT(8,KBDUM)				;SEND <CR><LF>
		RETURN
 INALP2,	EDITSW = 0			;ANSWER WAS <LF>, INVALID DATA SWSW
		RETURN
SPACE 2
INNUM,					;READ NUMERIC ROUTINE
	KB=					;CLEAR KB BUFFER
	ACCEPT(KBD,KB)
	EDITSW = 1
	IF (KB .EQ. 'EXIT') GOTO EXIT		;EXIT POSSIBLE ON RECORD NUMBER
	CCNT = 0
	IF (KBD.EQ.10) GOTO INNUM2		;CHECK FOR <LF>
  INNUM1,	INCR CCNT			;LOOP FOR NUMIC CHAR CHECK
		IF (KB(CCNT,CCNT).GT.9) EDITSW=0
		IF (KB(CCNT,CCNT).LT.0) EDITSW=0
		IF (CCNT.LT.12) GOTO INNUM1		;FINISH LOOP
	XMIT(8,KBDUM)				;SEND<CR><LF>
		RETURN
  INNUM2,	EDITSW = 0			;<LF> INPUT SETS INVALID SWITCH
		RETURN
END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search