SUBROUTINE FTN_SQLM_ZILL_ENTRY_SUB
        IMPLICIT NONE

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

	INCLUDE '(LIB$ROUTINES)'
        INCLUDE '($LIBDTDEF)'
	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'
!;;;;;
!       Constants we need
!;;;;;
	INTEGER*1   K_ELM_COUNT
        PARAMETER( K_ELM_COUNT=52)

        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, INVALID_MODE=-1)

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

	INTEGER*1   NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO, B_MODE
        INTEGER*8   DRAW_DT
	COMMON /DRAW_COMMON/DRAW_DT, NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO, B_MODE

!;;;;;
!	Local variables
!;;;;;
	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_DONE
	INTEGER*4   L_STAT, FMS_TERMINATOR, L_X, SQLCODE, L_DATE_CONTEXT, L_COMPONENT, L_Y

!;;;;;;;;;;
!	Main Logic
!;;;;;;;;;;

!;;;;;
!	Load the form
!;;;;;
 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 = ' '

        L_DATE_CONTEXT = 0
        L_COMPONENT = LIB$K_OUTPUT_FORMAT
        L_X = LIB$INIT_DATE_TIME_CONTEXT( L_DATE_CONTEXT, L_COMPONENT, '|!Y4!MN0!D0|')

	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 = ' '
	        CALL INSERT_DRAW_REC( SQLCODE, DRAW_DT, NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO)

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

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

                CALL COMMIT_MEGA( SQLCODE)

	      CASE (FDV$K_FK_F8)

	        B_MODE = FIND_MODE
	        CALL FTN_RETRIEVE_ENTRY_DATA( SCRN_REC.SCRN_STR)
                CALL FIND_DRAW_REC( SQLCODE, DRAW_DT, NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO)

	        SELECT CASE (SQLCODE)
	          CASE(0)
                    L_Y = LIB$FORMAT_DATE_TIME( SCRN_REC.DRAW_DT, DRAW_DT, L_DATE_CONTEXT)

	            WRITE (SCRN_REC.NO_1, '(I2)') NO_1
	            WRITE (SCRN_REC.NO_2, '(I2)') NO_2
	            WRITE (SCRN_REC.NO_3, '(I2)') NO_3
	            WRITE (SCRN_REC.NO_4, '(I2)') NO_4
	            WRITE (SCRN_REC.NO_5, '(I2)') NO_5
	            WRITE (SCRN_REC.MEGA_NO, '(I2)') MEGA_NO
	            L_X = FDV$PUTAL( SCRN_REC.SCRN_STR)


	          CASE DEFAULT
	            WRITE (SCRN_REC.MSG_TXT, 1002) SQLCODE
	            CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)

	        END SELECT

                CALL COMMIT_MEGA( SQLCODE)

	      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
                  CALL DELETE_SINGLE_DRAW_REC( SQLCODE, DRAW_DT)
	          IF (SQLCODE .NE. 0) THEN
	            WRITE (SCRN_REC.MSG_TXT, 1002) SQLCODE
	          END IF
	        END IF

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

	      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)
                  CALL UPDATE_DRAW_REC( SQLCODE, DRAW_DT, NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO)

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

	          CASE DEFAULT
	            WRITE (SCRN_REC.MSG_TXT, 1002) SQLCODE
	            CALL FTN_DISPLAY_ENTRY_ERROR( SCRN_REC.MSG_TXT)

	          END SELECT

                  CALL COMMIT_MEGA( SQLCODE)

	        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

	    END SELECT

500	CONTINUE

	GO TO 1000

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

1000	L_X = LIB$FREE_DATE_TIME_CONTEXT( L_DATE_CONTEXT)
        RETURN
	END

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

	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'
        INCLUDE '($LIBDTDEF)'
        INCLUDE '(LIB$ROUTINES)'

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

	INTEGER*1   NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO, B_MODE
        INTEGER*8   DRAW_DT
	COMMON /DRAW_COMMON/DRAW_DT, NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO, B_MODE

!;;;;;
!	Local variables
!;;;;;
	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, L_Y, L_X, L_DATE_CONTEXT, L_COMPONENT, L_Z
	INTEGER*1   B_STOP
        INTEGER*2   TIM_BUFF(8) /0,0,0,0,0,0,0,0/
        CHARACTER   WORK_NO*2, WORK_DATE_STR*8

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

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

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

        TIM_BUFF(1) = 1970
        TIM_BUFF(2) = 1
        TIM_BUFF(3) = 1

        WORK_DATE_STR = SCRN_REC.DRAW_DT
        L_Y = 127       ! allow defaults for all date time fields
        L_DATE_CONTEXT = 0
        L_COMPONENT = LIB$K_INPUT_FORMAT
        L_Z = LIB$INIT_DATE_TIME_CONTEXT( L_DATE_CONTEXT, L_COMPONENT, '|!Y4!MN0!D0 !H04!M0!S0!C2|')

        L_X = LIB$CONVERT_DATE_STRING( WORK_DATE_STR, DRAW_DT, L_DATE_CONTEXT, L_Y, TIM_BUFF)

        !
        !  Obtain numeric field values
        !
        WORK_NO = ADJUSTL(SCRN_REC.NO_1)
        READ (UNIT=WORK_NO, FMT='(I)') NO_1

        WORK_NO = ADJUSTL(SCRN_REC.NO_2)
        READ (UNIT=WORK_NO, FMT='(I)') NO_2

        WORK_NO = ADJUSTL(SCRN_REC.NO_3)
        READ (UNIT=WORK_NO, FMT='(I)') NO_3

        WORK_NO = ADJUSTL(SCRN_REC.NO_4)
        READ (UNIT=WORK_NO, FMT='(I)') NO_4

        WORK_NO = ADJUSTL(SCRN_REC.NO_5)
        READ (UNIT=WORK_NO, FMT='(I)') NO_5

        WORK_NO = ADJUSTL(SCRN_REC.MEGA_NO)
        READ (UNIT=WORK_NO, FMT='(I)') MEGA_NO

        L_X = LIB$FREE_DATE_TIME_CONTEXT( L_DATE_CONTEXT)

	RETURN
	END

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

	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'

	CHARACTER MSG_TXT*(*)
!;;;;;
!	Common areas
!;;;;;
	INTEGER*4   FMSSTATUS, RMSSTATUS, TCA(3), WORKSPACE(3)
	COMMON /FMS_MAP/ FMSSTATUS, RMSSTATUS, TCA, WORKSPACE
!;;;;;
!	Local variables
!;;;;;
	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
!;;;;;;;;;;	
!	Subroutine which servs as a UAR from the entry form.
!	Purpose is to test a numeric field to ensure it is 
!	in the range of 1 to 52.
!;;;;;;;;;;
	INTEGER FUNCTION DRAWING_RANGE
	IMPLICIT NONE

	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'
	INCLUDE '(LIB$ROUTINES)'

	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, L_INS_OVER
        INTEGER*4   L_HELP_NUM, L_X, L_FLDIDX, L_STAT, L_Y, L_Z

	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), &
                      %DESCR(UAR_VALS), L_CURSOR_POS, TERMINATOR, 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)

        L_X = 0
        WORK_NO = ADJUSTL(DATA_LINE)         ! obtain the first two characters

        READ ( UNIT=WORK_NO, 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