1   SUB BAS_SQLM_ZILL_ENTRY_SUB
    OPTION TYPE=EXPLICIT
    !
    !	BAS_SQLM_ZILL_ENTRY_SUB.BAS
    !
    !	Subroutine to allow entry, modification, and 
    !	deletion of records for the mega_zillionare example
    !	application.
    !
    %INCLUDE "FDVDEF" %FROM %LIBRARY "MEGA_TEXT_LIB"
    %INCLUDE "SYS$LIBRARY:SQL_LITERALS.BAS"
    %INCLUDE "LIB$ROUTINES" %FROM %LIBRARY
    %INCLUDE "$LIBDTDEF" %FROM %LIBRARY

    !;;;;;;;;;;
    !	Constants
    !;;;;;;;;;;
    DECLARE BYTE CONSTANT   elm_count% = 52%

    DECLARE BYTE CONSTANT   add_mode%           = 0%
    DECLARE BYTE CONSTANT   find_mode%          = 2%
    DECLARE BYTE CONSTANT   delete_mode%        = 3%
    DECLARE BYTE CONSTANT   invalid_mode%       = -1%
    !;;;;;;;;;;
    !	Maps
    !;;;;;;;;;;
    MAP (LOCAL_MAP) STRING  TRANSLATED_NAME$ = 255%

    MAP (SCRN_MAP)  STRING  DRAW_DT$ = 8%,	&
			    NO_1$ = 2%,		&
			    NO_2$ = 2%,		&
			    NO_3$ = 2%,		&
			    NO_4$ = 2%,		&
			    NO_5$ = 2%,		&
			    MEGA_NO$ = 2%,	&
			    MSG_TXT$ = 60%

    MAP (SCRN_MAP) STRING SCRN_STR$ = 80%

    MAP (FMS_MAP)   LONG FMSSTATUS%, RMSSTATUS%, TCA%(3%), WORKSPACE%(3%)

    !;;;;;;;;;;
    !	Local Variables
    !;;;;;;;;;;
    DECLARE BYTE    B_DONE%, B_MODE%, B_ACTION%
    DECLARE WORD    W_X%
    DECLARE LONG    L_X%, L_ERR%, TERMINATOR% 

    DECLARE STRING  WORK_STR$, LOG_TXT$

    DECLARE BASIC$QUADWORD  DRAW_DT
    DECLARE BYTE            NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO
    DECLARE WORD            TIM_BUFF(8%)
    DECLARE LONG            L_DATE_CONTEXT%, L_DATE_IN_CONTEXT%, L_DEFAULTS%, &
                            L_COMPONENT%, SQLCODE%
    !;;;;;;;;;;
    !	Main Logic
    !;;;;;;;;;;
100 L_ERR% = 0%

	GOSUB A920_LOAD_FORM

        !
        !   Set up date formats
        !
        TIM_BUFF(0%) = 1970%
        TIM_BUFF(1%) = 1%
        TIM_BUFF(2%) = 1%

        L_DEFAULTS% = 127%

        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|')

        L_DATE_IN_CONTEXT% = 0%
        L_COMPONENT% = LIB$K_INPUT_FORMAT
        L_X% = LIB$INIT_DATE_TIME_CONTEXT( L_DATE_IN_CONTEXT%, L_COMPONENT%, '|!Y4!MN0!D0 !H04!M0!S0!C2|')


	SCRN_STR$ = " "
	B_DONE% = 0%
	B_MODE% = add_mode%
        B_ACTION% = 1%

	WHILE B_DONE% = 0%
	    GOSUB A930_USER_INPUT
	NEXT		    ! end while b_done% loop

    GOTO PROGRAM_EXIT


920 !;;;;;;;;;;
    !	Subroutine to load and display the FMS form
    !;;;;;;;;;;
 A920_LOAD_FORM:
	CALL FDV$SPADA( 0%)
	CALL FDV$SSIGQ( 0%)			! Set signal mode to bell.
	CALL FDV$CDISP( "ZILL_ENTRY2")		! display our form

    RETURN

930 !;;;;;;;;;;
    !	Subroutine to process user input from the form.
    !;;;;;;;;;;
 A930_USER_INPUT:

	CALL FDV$GETAL( SCRN_STR$, TERMINATOR%)

	GOSUB U20100_CHECK_TERMINATOR

	SELECT B_ACTION%

	    CASE 2
		B_MODE% = add_mode%
		GOSUB B1000_ADD_RECORD

	    CASE 3
		B_MODE% = find_mode%
		GOSUB B1100_FIND_RECORD

	    CASE 4
		GOSUB B1200_DELETE_RECORD
		!
		!  Change mode after not before
		!  when deleting
		!
		B_MODE% = delete_mode%

            CASE 5
                IF B_MODE% = find_mode%
                THEN
                    GOSUB B1300_UPDATE_RECORD
                ELSE
                    MSG_TXT$ = "Must be in find mode to update"
                    GOSUB U20000_DISPLAY_ERROR
                END IF

                B_MODE% = add_mode%

	    CASE 99
		B_MODE% = invalid_mode%
		B_DONE% = -1%

	END SELECT
    RETURN

1000	!;;;;;;;;;;
	!   Subroutine to add a record to the drawing file.
	!;;;;;;;;;;
 B1000_ADD_RECORD:


        GOSUB C2000_RETRIEVE_DATA

	!
	!  Validate the data
	!
	MSG_TXT$ = " "

        CALL INSERT_DRAW_REC( SQLCODE%, DRAW_DT, NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO)

	SELECT SQLCODE%
	    CASE SQLCODE_SUCCESS
		SCRN_STR$ = " "
		CALL FDV$PUTAL( SCRN_STR$)
	
	    CASE SQLCODE_NO_DUP	    ! DUPKEYDET
		MSG_TXT$ = "Drawing date already on file   Hit Enter"
		GOSUB U20000_DISPLAY_ERROR

	    CASE ELSE
		MSG_TXT$ = "Err: " + NUM1$( SQLCODE%) + "Adding record"
		GOSUB U20000_DISPLAY_ERROR
	END SELECT

        CALL COMMIT_MEGA( SQLCODE%)
    RETURN


1100	!;;;;;;;;;;
	!	Subroutine to find a drawing record
	!;;;;;;;;;;
 B1100_FIND_RECORD:

        GOSUB C2000_RETRIEVE_DATA

        CALL FIND_DRAW_REC( SQLCODE%, DRAW_DT, NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO)

	SELECT SQLCODE%
	    CASE 0%
                L_X% = LIB$FORMAT_DATE_TIME( DRAW_DT$, DRAW_DT, L_DATE_CONTEXT%)
		RSET NO_1$	= NUM1$( NO_1)
		RSET NO_2$	= NUM1$( NO_2)
		RSET NO_3$	= NUM1$( NO_3)
		RSET NO_4$	= NUM1$( NO_4)
		RSET NO_5$	= NUM1$( NO_5)
		RSET MEGA_NO$	= NUM1$( MEGA_NO)

		CALL FDV$PUTAL( SCRN_STR$)

	    CASE SQLCODE_EOS		! RECNOTFOU
		MSG_TXT$ = "Unable to find drawing   Hit Enter"
		GOSUB U20000_DISPLAY_ERROR
		SCRN_STR$ = " "
		CALL FDV$PUTAL( SCRN_STR$)

	    CASE ELSE
		MSG_TXT$ = "Err: " + NUM1$( SQLCODE%) + "Finding record"
		GOSUB U20000_DISPLAY_ERROR
	END SELECT

        CALL COMMIT_MEGA( SQLCODE%)

1199  RETURN


1200	!;;;;;;;;;;
	!	Subroutine to delete a drawing record
	!;;;;;;;;;;
 B1200_DELETE_RECORD: 

	IF B_MODE% <> find_mode%
	THEN
	    MSG_TXT$ = "Must Find record before deleting   Hit Enter"
	    GOSUB U20000_DISPLAY_ERROR
            RETURN
	END IF

        CALL DELETE_SINGLE_DRAW_REC( SQLCODE%, DRAW_DT)

	IF SQLCODE% <> SQLCODE_SUCCESS
	THEN
	    MSG_TXT$ = "Err: " + NUM1$( SQLCODE%) + "Deleting record"
	    GOSUB U20000_DISPLAY_ERROR

	ELSE
	    SCRN_STR$ = " "
	    CALL FDV$PUTAL( SCRN_STR$)
	END IF

        CALL COMMIT_MEGA( SQLCODE%)
    RETURN

1300    !;;;;;;;;;;
        !   Subroutine to update the currently retrieved record
        !;;;;;;;;;;
 B1300_UPDATE_RECORD:

        GOSUB C2000_RETRIEVE_DATA

        CALL UPDATE_DRAW_REC( SQLCODE%, DRAW_DT, NO_1, NO_2, NO_3, NO_4, NO_5, MEGA_NO)
        
        IF SQLCODE% <> SQLCODE_SUCCESS
        THEN
	    MSG_TXT$ = "Err: " + NUM1$( SQLCODE%) + "Updating record"
            GOSUB U20000_DISPLAY_ERROR
            RETURN

        ELSE
            SCRN_STR$ = " "     ! blank out the display buffer
            CALL FDV$PUTAL( SCRN_STR$)
        END IF

        CALL COMMIT_MEGA( SQLCODE%)

    RETURN

2000    !;;;;;;;;;;
        !   Subroutine to read screen data from workspace.
        !   Since both the update and the add routines need
        !   to do this, moved it out into its own subroutine.
        !;;;;;;;;;;
 C2000_RETRIEVE_DATA:

        !
        !	Put good values in record to empty out.  
        !	A space would put bogus values in numeric fields.
        !
        NO_1 = 0%
        NO_2 = 0%
        NO_3 = 0%
        NO_4 = 0%
        NO_5 = 0%
        MEGA_NO = 0%

        !
        !   If the user doesn't understand how to use the screen they 
        !   could have hit the add key prior to doing any entry.
        !   trap for this and allow them to finish entry.
        !   Don't require user to hit enter, just leave message on screen
        !
        WORK_STR$ = DRAW_DT$
        WORK_STR$ = EDIT$( DRAW_DT$, 2%)
        IF LEN( WORK_STR$) < 8%  AND B_MODE% <> find_mode%
        THEN
            MSG_TXT$ = "Please enter record"
            CALL FDV$PUT( MSG_TXT$, 'MSG_TXT')
            RETURN
        END IF

        L_X% = LIB$CONVERT_DATE_STRING( DRAW_DT$, DRAW_DT, L_DATE_IN_CONTEXT%, L_DEFAULTS%, TIM_BUFF())

        !
        !   Snag the numeric fields
        !   Because we have function keys to control the action
        !   the fields could contain blanks eventhough we
        !   have a "9" for the edit clause and have the field
        !   flagged as requiring entry.
        !
        WHEN ERROR IN
            L_ERR%	    = 0%
            W_X%	    = 1%
            WORK_STR$	    = NO_1$
            NO_1  = VAL%( EDIT$( WORK_STR$, 2%))

            W_X%	    = 2%
            WORK_STR$	    = NO_2$ 
            NO_2  = VAL%( EDIT$( WORK_STR$, 2%))

            W_X%	    = 3%
            WORK_STR$	    = NO_3$
            NO_3  = VAL%( EDIT$( WORK_STR$, 2%))

            W_X%	    = 4%
            WORK_STR$	    = NO_4$
            NO_4  = VAL%( EDIT$( WORK_STR$, 2%))

            W_X%	    = 5%
            WORK_STR$	    = NO_5$
            NO_5  = VAL%( EDIT$( WORK_STR$, 2%))

            W_X%	    = 99%
            WORK_STR$	    = MEGA_NO$
            MEGA_NO = VAL%( EDIT$( WORK_STR$, 2%))

        USE
            L_ERR% = ERR
            IF W_X% < 99%
            THEN
                MSG_TXT$ = "Invalid number in NO " &
                  	   + NUM1$( W_X%) + " value " + WORK_STR$
            ELSE
                MSG_TXT$ = "Invalid Mega number " + WORK_STR$
            END IF
	    
        END WHEN
	

        IF L_ERR% > 0%
        THEN
            GOSUB U20000_DISPLAY_ERROR
            RETURN
        END IF


    RETURN

20000	!;;;;;;;;;;
	!  Utility subroutine to display error message on form.
	!;;;;;;;;;;
 U20000_DISPLAY_ERROR:
	    CALL FDV$BELL
	    CALL FDV$PUT( MSG_TXT$, 'MSG_TXT')
	    CALL FDV$WAIT
	    MSG_TXT$ = " "
	    CALL FDV$PUT( MSG_TXT$,  'MSG_TXT')
	RETURN


20100	!;;;;;;;;;;
	!   Subroutine to check the terminate entered by user
	!;;;;;;;;;;
 U20100_CHECK_TERMINATOR:

	SELECT TERMINATOR%

	    CASE FDV$K_FK_F7
		B_ACTION% = 2%

	    CASE FDV$K_FK_F8
		B_ACTION% = 3%

	    CASE FDV$K_FK_F9
		B_ACTION% = 4%

	    CASE FDV$K_FK_F10	    
		B_ACTION% = 99%

	    CASE FDV$K_FK_F11
		B_ACTION% = 5%

	    CASE ELSE
		B_ACTION% = 1%
	END SELECT

    RETURN


32760	!  End of module
 PROGRAM_EXIT:
        L_X% = LIB$FREE_DATE_TIME_CONTEXT( L_DATE_CONTEXT%)
        L_X% = LIB$FREE_DATE_TIME_CONTEXT( L_DATE_IN_CONTEXT%)

	END SUB


        !;;;;;;;;;;
        !   This function is called as a UAR from our form.
        !   It's purpose is to determine if the numbers entered are
        !   within a valid range.
        !;;;;;;;;;;
32761 FUNCTION INTEGER DRAWING_RANGE
        OPTION TYPE=EXPLICIT

        %INCLUDE "FDVDEF" %FROM %LIBRARY "MEGA_TEXT_LIB"

        MAP (DRAWING_RANGE_MAP) STRING FORM_NAME$=31%, UAR_VALS$=80%, &
                             FIELD_NAME$=31%, DATA_LINE$=132%

        DECLARE LONG TERMINATOR%, L_TCA_PTR%, L_WORKSPACE_PTR%, &
                     L_CURSOR_POS%, L_INS_OVER%, L_HELP_NUM%, L_X%, &
                     L_FLDIDX%

        DECLARE STRING WORK_STR$

        FORM_NAME$ = " "
        UAR_VALS$ = " "
        FIELD_NAME$ = " "
        DATA_LINE$ = " "

        !
        !  Obtain the UAR information.
        !
        CALL FDV$RETCX( L_TCA_PTR%, L_WORKSPACE_PTR%, FORM_NAME$, &
                        UAR_VALS$, L_CURSOR_POS%, TERMINATOR%, &
                        L_INS_OVER%, L_HELP_NUM%)

        !
        !   What field are we in
        !
        CALL FDV$RETFN( FIELD_NAME$, L_FLDIDX%)

        !
        !   Obtain the field data
        !
        CALL FDV$RET( DATA_LINE$, FIELD_NAME$, L_FLDIDX%)

        WORK_STR$ = EDIT$( DATA_LINE$, 2%)

        L_X% = VAL%( WORK_STR$)

        IF L_X% >= 1%  AND  L_X% <= 52%
        THEN
            DRAWING_RANGE = FDV$K_UVAL_SUC
        ELSE
            DRAWING_RANGE = FDV$K_UVAL_FAIL
        END IF

    FUNCTIONEND