SUBROUTINE FTN_ZILL_ENTRY_SUB
        IMPLICIT NONE

    !   Subroutine to allow entry and maintenance 
    !   of records for the mega_zillionare example
    !   application.

	INCLUDE '(LIB$ROUTINES)'
	INCLUDE '($FORIOSDEF)'
	!DEC$ OPTIONS /NOALIGN
        INCLUDE 'MEGA_TEXT_LIB (FTN_MEGA_RECS)'
	!DEC$ END OPTIONS
	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'
C;;;;;
C       Constants we need
C;;;;;
	INTEGER*1   K_DRAW_CHAN, K_ELM_COUNT
        PARAMETER( K_DRAW_CHAN=6, K_ELM_COUNT=52)

        CHARACTER*12    DRAWING_DATA
        PARAMETER( DRAWING_DATA='MY_MEGA_FILE')

        REAL    ONE_SECOND
        PARAMETER( ONE_SECOND=1.0)

	INTEGER*1 ADD_MODE, FIND_MODE, DELETE_MODE, INVALID_MODE
	PARAMETER( ADD_MODE=0, FIND_MODE=2, DELETE_MODE=3,
     1             INVALID_MODE=-1)

C;;;;;
C	Common areas
C;;;;;
	INTEGER*4   FMSSTATUS, RMSSTATUS, TCA(3), WORKSPACE(3)
	COMMON /FMS_MAP/ FMSSTATUS, RMSSTATUS, TCA, WORKSPACE

	RECORD /DRAWING_RECORD/DRAW_REC
	COMMON /DRAW_COMMON/DRAW_REC
C;;;;;
C	Local variables
C;;;;;
	STRUCTURE /SCRN_STRUCT/
	  UNION
	    MAP
	        CHARACTER*8 DRAW_DT
	        CHARACTER*2 NO_1, NO_2, NO_3, NO_4, NO_5
	        CHARACTER*2 MEGA_NO
	        CHARACTER*60 MSG_TXT
	    END MAP
	    MAP
	        CHARACTER*80 SCRN_STR
	    END MAP
	  END UNION
	END STRUCTURE

	RECORD /SCRN_STRUCT/SCRN_REC

	INTEGER*1   B_LOC_COUNT, B_MODE, B_DONE
	INTEGER*4   L_STAT, FMS_TERMINATOR, L_X

C;;;;;;;;;;
C	Main Logic
C;;;;;;;;;;

 100    CALL FTN_FILL_IN_LOGICALS

 210	OPEN (UNIT=K_DRAW_CHAN, 
     1        FILE=DRAWING_DATA,
     2        STATUS='OLD',
     3        ORGANIZATION='INDEXED',
     4        ACCESS='KEYED',
     5        RECORDTYPE='FIXED',
     6        FORM='UNFORMATTED',
     7        RECL=K_DRAWING_RECORD_SIZE/4,
     8        CARRIAGECONTROL='FORTRAN',
     9        KEY=(1:8:CHARACTER),
     1        DISP='KEEP',
     2        SHARED,
     3        IOSTAT=L_STAT,
     4        ERR=999)

C;;;;;
C	Load the form
C;;;;;
 310	L_X = FDV$SPADA( 0)  ! keypad data entry mode
	L_X = FDV$SSIGQ( 0)  ! signal mode bell
	L_X = FDV$CDISP( 'ZILL_ENTRY2')


	B_MODE = ADD_MODE
	B_DONE = 0
	SCRN_REC.SCRN_STR = ' '

	DO 500, WHILE (B_DONE .EQ. 0)
	    L_X = FDV$GETAL( SCRN_REC.SCRN_STR, FMS_TERMINATOR)

	    SELECT CASE( FMS_TERMINATOR)

	      CASE (FDV$K_FK_F7)

	        B_MODE = ADD_MODE
	        CALL FTN_RETRIEVE_ENTRY_DATA( SCRN_REC.SCRN_STR)
	        SCRN_REC.MSG_TXT = ' '
	        WRITE( K_DRAW_CHAN, IOSTAT=L_STAT) DRAW_REC

	        SELECT CASE (L_STAT)
	          CASE (0)
	            SCRN_REC.SCRN_STR = ' '
	            L_X = FDV$PUTAL( SCRN_REC.SCRN_STR)

	          CASE (FOR$IOS_INCKEYCHG)
	            SCRN_REC.MSG_TXT = 'Duplicate Key'
	            CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)

	          CASE DEFAULT
	            WRITE (SCRN_REC.MSG_TXT, 1002) L_STAT
	            CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	        END SELECT

	      CASE (FDV$K_FK_F8)

	        B_MODE = FIND_MODE
 512	        READ (K_DRAW_CHAN, KEYGE=SCRN_REC.DRAW_DT,
     1                IOSTAT=L_STAT) DRAW_REC

	        SELECT CASE (L_STAT)
	          CASE(0)
	            SCRN_REC.DRAW_DT = DRAW_REC.DRAW_DT
	            WRITE (SCRN_REC.NO_1, '(I2)') DRAW_REC.NO_1
	            WRITE (SCRN_REC.NO_2, '(I2)') DRAW_REC.NO_2
	            WRITE (SCRN_REC.NO_3, '(I2)') DRAW_REC.NO_3
	            WRITE (SCRN_REC.NO_4, '(I2)') DRAW_REC.NO_4
	            WRITE (SCRN_REC.NO_5, '(I2)') DRAW_REC.NO_5
	            WRITE (SCRN_REC.MEGA_NO, '(I2)') DRAW_REC.MEGA_NO
	            L_X = FDV$PUTAL( SCRN_REC.SCRN_STR)

	          CASE (FOR$IOS_ATTACCNON)
	            SCRN_REC.MSG_TXT = 'Record Not Found'
	            CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)

	          CASE (FOR$IOS_SPERECLOC)
	            CALL LIB$WAIT( ONE_SECOND)
	            GO TO 512
	        END SELECT

	      CASE (FDV$K_FK_F9)
	        IF (B_MODE .NE. FIND_MODE) THEN
	          SCRN_REC.MSG_TXT = 'Must Find record before del'
	          CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	        ELSE
	          DELETE (K_DRAW_CHAN, IOSTAT=L_STAT)
	          IF (L_STAT .NE. 0) THEN
	            WRITE (SCRN_REC.MSG_TXT, 1002) L_STAT
	          END IF
	        END IF

	        SCRN_REC.SCRN_STR = ' '
	        L_X = FDV$PUTAL( SCRN_REC.SCRN_STR)
 
	        B_MODE = DELETE_MODE

	      CASE (FDV$K_FK_F10)
	        B_DONE = -1

	      CASE (FDV$K_FK_F11)
	        IF (B_MODE .EQ. FIND_MODE) THEN
	          CALL FTN_RETRIEVE_ENTRY_DATA( SCRN_REC.SCRN_STR)
	          REWRITE (K_DRAW_CHAN, IOSTAT=L_STAT) DRAW_REC

	          SELECT CASE (L_STAT)
	          CASE(0)
	            SCRN_REC.SCRN_STR = ' '
	            L_X = FDV$PUTAL( SCRN_REC.SCRN_STR)

	          CASE (FOR$IOS_ATTACCNON)
	            SCRN_REC.MSG_TXT = 'Record Not Found'
	            CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)

	          CASE (FOR$IOS_SPERECLOC)
	            CALL LIB$WAIT( ONE_SECOND)
	            GO TO 512
	          END SELECT

	        ELSE

	          SCRN_REC.MSG_TXT = 'Must Find record before del'
	          CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)

	        END IF

	        B_MODE = ADD_MODE

	      CASE DEFAULT
	        B_MODE = ADD_MODE
	    END SELECT

500	CONTINUE

	GO TO 1000

999	PRINT *, 'Error ', L_STAT, ' opening drawing_stats'
	GO TO 1000

1002	FORMAT( 'Error ', I8, ' accessing drawing file')


1000	CLOSE( K_DRAW_CHAN)
	RETURN
	END

C;;;;;;;;;;
C	Subroutine to read and convert screen data
C;;;;;;;;;;
	SUBROUTINE FTN_RETRIEVE_ENTRY_DATA( SCRN_STR)
	IMPLICIT NONE


        INCLUDE 'MEGA_TEXT_LIB (FTN_MEGA_RECS)'
	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'

	CHARACTER SCRN_STR*(*)
C;;;;;
C	Common areas
C;;;;;
	INTEGER*4   FMSSTATUS, RMSSTATUS, TCA(3), WORKSPACE(3)
	COMMON /FMS_MAP/ FMSSTATUS, RMSSTATUS, TCA, WORKSPACE

	RECORD /DRAWING_RECORD/DRAW_REC
	COMMON /DRAW_COMMON/DRAW_REC

C;;;;;
C	Local variables
C;;;;;
	STRUCTURE /SCRN_STRUCT/
	  UNION
	    MAP
	        CHARACTER*8 DRAW_DT
	        CHARACTER*2 NO_1, NO_2, NO_3, NO_4, NO_5
	        CHARACTER*2 MEGA_NO
	        CHARACTER*60 MSG_TXT
	    END MAP
	    MAP
	        CHARACTER*80 SCRN_STR
	    END MAP
	  END UNION
	END STRUCTURE

	RECORD /SCRN_STRUCT/SCRN_REC

	INTEGER*4 L_ERR
	INTEGER*1 B_STOP

	!
	!  Empty the existing record
	!
2000	DRAW_REC.DRAW_DT = ' '
	DRAW_REC.NO_1    = 0
	DRAW_REC.NO_2    = 0
	DRAW_REC.NO_3    = 0
	DRAW_REC.NO_4    = 0
	DRAW_REC.NO_5    = 0
	DRAW_REC.MEGA_NO = 0

	SCRN_REC.SCRN_STR = SCRN_STR
	!
	!  Did they enter a key value?
	!
	IF (SCRN_REC.SCRN_STR(8:8) .LE. ' ') THEN
	    SCRN_REC.MSG_TXT = 'All 8 digits of date needed'
	    CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	    RETURN
	END IF

	DRAW_REC.DRAW_DT = SCRN_REC.DRAW_DT


	!
	!  Is the last byte blank?  If so, only read the 
	!  first byte.
	!
	IF (SCRN_REC.NO_1(2:2) .GT. ' ') THEN
	    B_STOP = 2
	ELSE
	    B_STOP = 1
	END IF

	READ (UNIT=SCRN_REC.NO_1(1:B_STOP),FMT='(I)',IOSTAT=L_ERR) 
     1                DRAW_REC.NO_1

	IF (L_ERR .NE. 0) THEN
	    WRITE (SCRN_REC.MSG_TXT, 2002) L_ERR
	    CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	END IF


	IF (SCRN_REC.NO_2(2:2) .GT. ' ') THEN
	    B_STOP = 2
	ELSE
	    B_STOP = 1
	END IF

	READ (UNIT=SCRN_REC.NO_2(1:B_STOP),FMT='(I)',IOSTAT=L_ERR) 
     1                DRAW_REC.NO_2
	IF (L_ERR .NE. 0) THEN
	    WRITE (SCRN_REC.MSG_TXT, 2002) L_ERR
	    CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	END IF


	IF (SCRN_REC.NO_3(2:2) .GT. ' ') THEN
	    B_STOP = 2
	ELSE
	    B_STOP = 1
	END IF

	READ (UNIT=SCRN_REC.NO_3(1:B_STOP),FMT='(I)',IOSTAT=L_ERR) 
     1                DRAW_REC.NO_3
	IF (L_ERR .NE. 0) THEN
	    WRITE (SCRN_REC.MSG_TXT, 2002) L_ERR
	    CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	END IF


	IF (SCRN_REC.NO_4(2:2) .GT. ' ') THEN
	    B_STOP = 2
	ELSE
	    B_STOP = 1
	END IF

	READ (UNIT=SCRN_REC.NO_4(1:B_STOP),FMT='(I)', IOSTAT=L_ERR) 
     1                DRAW_REC.NO_4
	IF (L_ERR .NE. 0) THEN
	    WRITE (SCRN_REC.MSG_TXT, 2002) L_ERR
	    CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	END IF


	IF (SCRN_REC.NO_5(2:2) .GT. ' ') THEN
	    B_STOP = 2
	ELSE
	    B_STOP = 1
	END IF

	READ (UNIT=SCRN_REC.NO_5(1:B_STOP),FMT='(I)', IOSTAT=L_ERR) 
     1                DRAW_REC.NO_5
	IF (L_ERR .NE. 0) THEN
	    WRITE (SCRN_REC.MSG_TXT, 2002) L_ERR
	    CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	END IF


	IF (SCRN_REC.MEGA_NO(2:2) .GT. ' ') THEN
	    B_STOP = 2
	ELSE
	    B_STOP = 1
	END IF

	READ (UNIT=SCRN_REC.MEGA_NO(1:B_STOP),FMT='(I)', IOSTAT=L_ERR) 
     1                    DRAW_REC.MEGA_NO
	IF (L_ERR .NE. 0) THEN
	    WRITE (SCRN_REC.MSG_TXT, 2002) L_ERR
	    CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)
	END IF

2002	FORMAT ('Error ', I2, ' converting numeric')
	
	RETURN
	END

C;;;;;;;;;;
C	Subroutine to read and convert screen data
C;;;;;;;;;;
	SUBROUTINE FTN_DISPLAY_ENTRY_ERROR( MSG_TXT)
	IMPLICIT NONE


        INCLUDE 'MEGA_TEXT_LIB (FTN_MEGA_RECS)'
	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'

	CHARACTER MSG_TXT*(*)
C;;;;;
C	Common areas
C;;;;;
	INTEGER*4   FMSSTATUS, RMSSTATUS, TCA(3), WORKSPACE(3)
	COMMON /FMS_MAP/ FMSSTATUS, RMSSTATUS, TCA, WORKSPACE
C;;;;;
C	Local variables
C;;;;;
	INTEGER*4 FMS_TERMINATOR, L_X
	CHARACTER*60 BLANK_MSG

	L_X = FDV$PUT( MSG_TXT, 'MSG_TXT')
	L_X = FDV$WAIT( FMS_TERMINATOR)
	BLANK_MSG = ' '
	L_X = FDV$PUT( BLANK_MSG, 'MSG_TXT')

	RETURN
	END
C;;;;;;;;;;	
C	Subroutine which servs as a UAR from the entry form.
C	Purpose is to test a numeric field to ensure it is 
C	in the range of 1 to 52.
C;;;;;;;;;;
	INTEGER FUNCTION DRAWING_RANGE
	IMPLICIT NONE

	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'

	CHARACTER   FORM_NAME*31, UAR_VALS*80, FIELD_NAME*31
	CHARACTER   DATA_LINE*132, WORK_NO*2

	INTEGER*4   TERMINATOR, TCA_PTR, WORKSPACE_PTR, L_CURSOR_POS,
     1              L_INS_OVER, L_HELP_NUM, L_X, L_FLDIDX, L_STAT

	INTEGER*1   B_STOP
	
	FORM_NAME = ' '
	UAR_VALS = ' '
	FIELD_NAME = ' '
	DATA_LINE = ' '

	!
	! Obtain the UAR information
	!
	L_X = FDV$RETCX( TCA_PTR, WORKSPACE_PTR, %DESCR(FORM_NAME),
     1                %DESCR(UAR_VALS), L_CURSOR_POS, TERMINATOR, 
     1                L_INS_OVER, L_HELP_NUM)

	!
	! What field are we in
	!
	L_X = FDV$RETFN( FIELD_NAME, L_FLDIDX)

	!
	! Obtain the field data
	!
	L_X = FDV$RET( DATA_LINE, FIELD_NAME, L_FLDIDX)

	WORK_NO = DATA_LINE


	IF (WORK_NO(1:1) .EQ. ' ') THEN
	    WORK_NO(1:1) = '0'
	END IF

	IF (WORK_NO(2:2) .EQ. ' ') THEN
	    B_STOP = 1
	ELSE
	    B_STOP = 2
	END IF

	READ( UNIT=WORK_NO(1:B_STOP), FMT='(I)') L_X

	IF (L_X .GE. 1  .AND. L_X .LE. 52) THEN
	    DRAWING_RANGE = FDV$K_UVAL_SUC
	ELSE
	    DRAWING_RANGE = FDV$K_UVAL_FAIL
	END IF
	
	RETURN
	END