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 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 INALP1, ;COULD LOOP HERE TO CHECK CHARS. XMIT(8,KBDUM) ;SEND RETURN INALP2, EDITSW = 0 ;ANSWER WAS , 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 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 RETURN INNUM2, EDITSW = 0 ; INPUT SETS INVALID SWITCH RETURN END