1   OPTION TYPE=EXPLICIT
    !
    !	BASIC_ZILL_ENTRY.BAS
    !
    !	Stand alone program to allow entry, modification, and 
    !	deletion of records for the mega_zillionare example
    !	application.
    !
    %INCLUDE "MEGA_INC:MEGA_RECS.INC"	    ! our record definitions
    %INCLUDE "MEGA_INC:FDVDEF.INC"	    ! FMS definitions

    %INCLUDE "LIB$ROUTINES" %FROM %LIBRARY



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


    DECLARE STRING CONSTANT drawing_data$ = "MY_MEGA_FILE"


    !;;;;;;;;;;
    !	Maps
    !;;;;;;;;;;
    MAP (LOCAL_MAP) STRING  TRANSLATED_NAME$ = 255%



    MAP (DRAW_MAP)  DRAWING_RECORD		DRAW_REC

    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%


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

    DECLARE STRING  WORK_STR$, LOG_TXT$

    DIM INTEGER TCA%(3%)			! Terminal control area
    DIM INTEGER WORKSPACE%( 3)			! general workspace for FMS


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

100 L_ERR% = 0%
    GOSUB A900_FILL_IN_LOGICALS

    GOSUB A910_OPEN_FILES

    IF L_ERR% = 0%
    THEN

	GOSUB A920_LOAD_FORM

	SCRN_STR$ = " "
	B_DONE% = 0%
	B_MODE% = -1%	    ! set to invalid value

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

    END IF

    CALL FDV$LCLOS			! close the form library
    CALL FDV$DWKSP( WORKSPACE%())	! delete workspace
    CALL FDV$DTERM( TCA%())		! terminate FMS



    GOTO PROGRAM_EXIT

900 !;;;;;;;;;;
    !	Subroutine to fill in logical values
    !	Ordinarily developers simply "assume" that either
    !	logicals have been defined or do so in a job stream
    !	but this will allow the demonstration of service calls.
    !;;;;;;;;;;
 A900_FILL_IN_LOGICALS:

        WORK_STR$ = drawing_data$
        TRANSLATED_NAME$ = " "      ! destination has to be pre-allocated
        W_X% = 0%

        L_X% = LIB$GET_LOGICAL( WORK_STR$, TRANSLATED_NAME$, W_X%,,,,)

        IF LEN( TRM$( TRANSLATED_NAME$)) < 1
        THEN
            LOG_TXT$ = drawing_data$ + ".IDX"
            L_X% = LIB$SET_LOGICAL( WORK_STR$, LOG_TXT$,,,)
        END IF

    RETURN



910 !;;;;;;;;;;
    !	Subroutine to open indexed files
    !;;;;;;;;;;
 A910_OPEN_FILES:
        WHEN ERROR IN
            L_ERR% = 0%
            OPEN drawing_data$ FOR INPUT AS FILE #draw_chan%,   &
                ORGANIZATION INDEXED FIXED,                     &
                ALLOW NONE, ACCESS MODIFY,                      &
                RECORDTYPE FORTRAN,                             &
                RECORDSIZE drawing_record_size,                 &
		MAP DRAW_MAP
        USE
            L_ERR% = ERR
            PRINT "Unable to open input file"; drawing_data$
            PRINT "Error: ";L_ERR%;" ";ERT$( L_ERR%)
        END WHEN


    RETURN  

920 !;;;;;;;;;;
    !	Subroutine to load and display the FMS form
    !;;;;;;;;;;
 A920_LOAD_FORM:
	CALL FDV$ATERM( TCA%(), 12, 2%)		! attach to default terminal
	CALL FDV$STAT( FMSSTATUS%, RMSSTATUS%)	! check status

	CALL FDV$AWKSP( WORKSPACE%(), 2000%)	! general workspace for FMS
	CALL FDV$STAT( FMSSTATUS%, RMSSTATUS%)	! check status
	
	CALL FDV$LOPEN( 'MEGA_ZILL', 1%)	! open form library and attach to channel 1
	CALL FDV$STAT( FMSSTATUS%, RMSSTATUS%)	! check status


	!;;;;;
	!  We could call this function to set the keypad mode
	!  to application from terminal.  This program will force
	!  it back to normal entry mode.  Had we put a 1% as the parameter
	!  that would force it to application mode.  For data entry we 
	!  want the keypad to work like a keypad.
	!;;;;;
	!
	CALL FDV$SPADA( 0%)

	CALL FDV$SSIGQ( 0%)			! Set signal mode to bell.
	CALL FDV$STAT( FMSSTATUS%, RMSSTATUS%)	! check status


	CALL FDV$SSRV( FMSSTATUS%, RMSSTATUS%)  !  Set all future alls to return two status
						!  variables. so we don't have to call
						!  FDV$STAT each time.


	CALL FDV$CDISP( "ZILL_ENTRY")		! 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 1	    ! single field entry
		GOSUB B1500_SINGLE_FIELD_ENTRY
		GOSUB B1000_ADD_RECORD IF B_ACTION% = 2%

	    CASE 2
		B_MODE% = 0%
		GOSUB B1000_ADD_RECORD

	    CASE 3
		B_MODE% = 2%
		GOSUB B1100_FIND_RECORD

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

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

	END SELECT
	

    RETURN

1000	!;;;;;;;;;;
	!
	!;;;;;;;;;;
 B1000_ADD_RECORD:

	!
	!	Put good values in record to empty out.  
	!	A space would put bogus values in numeric fields.
	!
	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%

	!
	!   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%
	THEN
	    MSG_TXT$ = "Please enter record"
	    CALL FDV$PUT( MSG_TXT$, 'MSG_TXT')
	    RETURN
	END IF


	!;;;;;
	!  Every shop you go to will have their own home grown 
	!  date validation routine.  I am not going to bother
	!  developing one here that hasn't had 30 years to get
	!  all of the bugs worked out of it. Yes, this is the key
	!  field and in a production system would be the one most
	!  requiring validation.  Validating the numeric fields
	!  will show the points I wish to show.
	!;;;;;
	DRAW_REC::DRAW_DT = DRAW_DT$

	!
	!   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$
	    DRAW_REC::NO_1  = VAL%( EDIT$( WORK_STR$, 2%))

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

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

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

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

	    W_X%	    = 99%
	    WORK_STR$	    = MEGA_NO$
	    DRAW_REC::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


	!
	!  Validate the data
	!
	MSG_TXT$ = " "

	IF DRAW_REC::NO_1 < 1%  OR  DRAW_REC::NO_1 > 52%
	THEN
	    MSG_TXT$ = "No_1 not in range of 1 to 52   Hit Enter"
	    GOSUB U20000_DISPLAY_ERROR
	    RETURN

	END IF


	IF DRAW_REC::NO_2 < 1%  OR  DRAW_REC::NO_2 > 52%
	THEN
	    MSG_TXT$ = "No_2 not in range of 1 to 52   Hit Enter"
	    GOSUB U20000_DISPLAY_ERROR
	    RETURN

	END IF


	IF DRAW_REC::NO_3 < 1%  OR  DRAW_REC::NO_3 > 52%
	THEN
	    MSG_TXT$ = "No_3 not in range of 1 to 52   Hit Enter"
	    GOSUB U20000_DISPLAY_ERROR
	    RETURN

	END IF


	IF DRAW_REC::NO_4 < 1%  OR  DRAW_REC::NO_4 > 52%
	THEN
	    MSG_TXT$ = "No_4 not in range of 1 to 52   Hit Enter"
	    GOSUB U20000_DISPLAY_ERROR
	    RETURN

	END IF


	IF DRAW_REC::NO_5 < 1%  OR  DRAW_REC::NO_5 > 52%
	THEN
	    MSG_TXT$ = "No_5 not in range of 1 to 52   Hit Enter"
	    GOSUB U20000_DISPLAY_ERROR
	    RETURN

	END IF


	IF DRAW_REC::MEGA_NO < 1%  OR  DRAW_REC::MEGA_NO > 52%
	THEN
	    MSG_TXT$ = "Mega No. not in range of 1 to 52   Hit Enter"
	    GOSUB U20000_DISPLAY_ERROR
	    RETURN

	END IF


	!
	!  Getting here means the data is good
	!  Try adding the record and trap for duplicate key.
	!
	WHEN ERROR IN
	    L_ERR% = 0%
	    PUT #draw_chan%
	USE
	    L_ERR% = ERR
	END WHEN


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

	    CASE ELSE
		MSG_TXT$ = "Err: " + NUM1$( L_ERR%) + ERT$( L_ERR%)
		GOSUB U20000_DISPLAY_ERROR
	END SELECT

    RETURN


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

	WHEN ERROR IN
	    L_ERR% = 0%
	    GET #draw_chan%, KEY #0% GE DRAW_DT$
	USE
	    L_ERR% = ERR

	    !  RECBUCLOC   With ALLOW NONE on the file it shouldn't
	    !  Be possible to get a locked record, but this shows you
	    !  How to trap for it.
	    !
	    IF L_ERR% = 154%
	    THEN
		SLEEP 2%
		L_ERR% = 0%
		RETRY
	    END IF

	END WHEN

	SELECT L_ERR%
	    CASE 0%
		DRAW_DT$	= DRAW_REC::DRAW_DT
		RSET NO_1$	= NUM1$( DRAW_REC::NO_1)
		RSET NO_2$	= NUM1$( DRAW_REC::NO_2)
		RSET NO_3$	= NUM1$( DRAW_REC::NO_3)
		RSET NO_4$	= NUM1$( DRAW_REC::NO_4)
		RSET NO_5$	= NUM1$( DRAW_REC::NO_5)
		RSET MEGA_NO$	= NUM1$( DRAW_REC::MEGA_NO)

		CALL FDV$PUTAL( SCRN_STR$)

	    CASE 155%		! 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$( L_ERR%) + ERT$( L_ERR%)
		GOSUB U20000_DISPLAY_ERROR
	END SELECT


1199  RETURN


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

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


	WHEN ERROR IN
	    L_ERR% = 0%
	    DELETE #draw_chan%
	USE
	    L_ERR% = 0%
	END WHEN


	IF L_ERR% > 0%
	THEN
	    MSG_TXT$ = "Err: " + NUM1$( L_ERR%) + ERT$( L_ERR%)
	    GOSUB U20000_DISPLAY_ERROR

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

    RETURN

1500	!;;;;;;;;;;
	!   Subroutine to do field by field entry
	!;;;;;;;;;;
 B1500_SINGLE_FIELD_ENTRY:

	UNTIL DRAW_DT$ > " "  OR  B_ACTION% <> 1%
	    CALL FDV$GETAF( DRAW_DT$, 'DRAW_DT', TERMINATOR%)
	    GOSUB U20100_CHECK_TERMINATOR
	NEXT

	UNTIL NO_1$ > " "  OR  B_ACTION% <> 1%
	    CALL FDV$GETAF( NO_1$, 'NO_1', TERMINATOR%)
	    GOSUB U20100_CHECK_TERMINATOR
	NEXT

	UNTIL NO_2$ > " "  OR  B_ACTION% <> 1%
	    CALL FDV$GETAF( NO_2$, 'NO_2', TERMINATOR%)
	    GOSUB U20100_CHECK_TERMINATOR
	NEXT

	UNTIL NO_3$ > " "  OR  B_ACTION% <> 1%
	    CALL FDV$GETAF( NO_3$, 'NO_3', TERMINATOR%)
	    GOSUB U20100_CHECK_TERMINATOR
	NEXT

	UNTIL NO_4$ > " "  OR  B_ACTION% <> 1%
	    CALL FDV$GETAF( NO_4$, 'NO_4', TERMINATOR%)
	    GOSUB U20100_CHECK_TERMINATOR
	NEXT 

	UNTIL NO_5$ > " "  OR  B_ACTION% <> 1%
	    CALL FDV$GETAF( NO_5$, 'NO_5', TERMINATOR%)
	    GOSUB U20100_CHECK_TERMINATOR
	NEXT

	UNTIL MEGA_NO$ > " "  OR  B_ACTION% <> 1%
	    CALL FDV$GETAF( MEGA_NO$, 'MEGA_NO', TERMINATOR%)
	    GOSUB U20100_CHECK_TERMINATOR
	NEXT


    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	!;;;;;;;;;;
	!
	!;;;;;;;;;;
 U20100_CHECK_TERMINATOR:


	SELECT TERMINATOR%

	    CASE FDV$K_FT_NTR
		IF MEGA_NO$ > " "
		THEN
		    !  user finished field by field mode entry
		    !  and now wants the record added
		    !
		    B_ACTION% = 2%  IF B_ACTION% = 1%
		ELSE
		    B_ACTION% = 1%	! field by field entry
		    CALL FDV$PFT( FDV$K_FT_NXT)
		END IF

	    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 ELSE
		B_ACTION% = 0%
	END SELECT

    RETURN


32767	!  End of module
 PROGRAM_EXIT:
	WHEN ERROR IN
	    CLOSE #draw_chan%
	USE
	    ! ignore error on close
	END WHEN


	END