SUBROUTINE FTN_ZILL_BROWSE_SUB
        IMPLICIT NONE

    !   Subroutine to allow browsing
    !   of records for the mega_zillionare example
    !   application.

	INCLUDE '(LIB$ROUTINES)'
	INCLUDE '($FORIOSDEF)'
        INCLUDE 'MEGA_TEXT_LIB (FTN_MEGA_RECS)'
	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*4   K_MAX_RECORDS
	PARAMETER( K_MAX_RECORDS=5000)

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;;;;;
	RECORD /DRAWING_RECORD/DRAW_REC


	INTEGER*1   B_ACTION, B_LOC_COUNT
	INTEGER*4   L_STAT, L_REC_COUNT
	INTEGER*4   L_TOP, L_BOTTOM, L_DRAW_ERR, L_X
	CHARACTER*8 DRAW_DATES( K_MAX_RECORDS)

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_DRAW_ERR,
     4        ERR=999)


C;;;;;
C	Count the records
C	FORTRAN doesn't offer a good way to do this without
C	a secondary key on the file.  We have several choices.
C	Choice 1 is to abandon FORTRAN IO using system service
C	calls.  Since we will be doing that in C, not a good
C	option here.  This leaves us with storing either all
C	of the data or just the key values in an array.
C	We will have to read through the data twice.
C	The FIND statement in FORTRAN is only for relative files.
C
C	If FORTRAN 90 had supported the DICTIONARY statement
C	we could have implemented an almost perfect solution
C	because FORTRAN 90 supports ALLOCATABLE and ALLOCATE.
C	This allows FORTRAN to dynamically allocate arrays.
C	Given I didn't want to use an OS level allocation
C	and manage it all on my own, that left me with the
C	pre-compiled hard coded maximum count.
C;;;;;
	B_LOC_COUNT = 0
	L_REC_COUNT = 1

300	READ (K_DRAW_CHAN, KEYGE=' ', IOSTAT=L_STAT, ERR=996)
     1        DRAW_REC

	SELECT CASE( L_STAT)
	    CASE (0)
	        DRAW_DATES( L_REC_COUNT) = DRAW_REC.DRAW_DT
	        L_REC_COUNT = L_REC_COUNT + 1

	    CASE (FOR$IOS_SPERECLOC)
	        B_LOC_COUNT = B_LOC_COUNT + 1
	        IF (B_LOC_COUNT .LT. 100) THEN
	            CALL LIB$WAIT( ONE_SECOND)
	            GO TO 300
	        END IF

	    CASE DEFAULT
	        PRINT *, 'Error ', L_STAT, 'Getting first record'
	        GO TO 1000
	END SELECT

 302	READ (K_DRAW_CHAN, IOSTAT=L_STAT, END=310, ERR=996)
     1            DRAW_REC

	SELECT CASE( L_STAT)
	    CASE (0)
	        DRAW_DATES( L_REC_COUNT) = DRAW_REC.DRAW_DT
	        L_REC_COUNT = L_REC_COUNT + 1
	        IF (L_REC_COUNT .LT. K_MAX_RECORDS) THEN
	            GO TO 302
	        ELSE
	            PRINT *, 'Maximum records loaded'
	        END IF

	    CASE (FOR$IOS_SPERECLOC)
	        B_LOC_COUNT = B_LOC_COUNT + 1
	        IF (B_LOC_COUNT .LT. 100) THEN
	            CALL LIB$WAIT( ONE_SECOND)
	            GO TO 302
	        END IF

	    CASE DEFAULT
	        PRINT *, 'Error ', L_STAT, 'Getting next record'
	        GO TO 1000
	END SELECT

	!
	!  Notice the hidden loop in the above logic
	!


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

C;;;;;
C	Display the data, and wait for the user to exit
C;;;;;
	B_ACTION = 0
	L_TOP    = 1
	L_BOTTOM = 10


	DO 360, WHILE (B_ACTION .NE. 99)
	    CALL FTN_BROWSE_USER_ACTION( DRAW_DATES, B_ACTION,
     1                L_REC_COUNT, L_TOP, L_BOTTOM, K_DRAW_CHAN)
 360	CONTINUE


	GOTO 1000

 996	PRINT *, 'Error ', L_DRAW_ERR, ' Reading file'
	GO TO 1000

 999	PRINT *, 'Error ', L_DRAW_ERR, ' opening drawing_stats'

 1000	CLOSE( K_DRAW_CHAN)
	RETURN
	END

C;;;;;;;;;;
C	Subroutine to handle user action while browsing
C;;;;;;;;;;
	SUBROUTINE FTN_BROWSE_USER_ACTION( DRAW_DATES, B_ACTION,
     1                    L_REC_COUNT, L_TOP, L_BOTTOM, K_DRAW_CHAN)
	IMPLICIT NONE

	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'

	CHARACTER*8 DRAW_DATES(*)
	BYTE        B_ACTION
	INTEGER*4   L_REC_COUNT, L_TOP, L_BOTTOM
	INTEGER*1   K_DRAW_CHAN


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;;;;;

	CHARACTER*255   WORK_STR
	INTEGER*4       TERMINATOR, L_X

C;;;;;
C	Main logic
C;;;;;
	CALL FTN_LOAD_BROWSE_DISPLAY( DRAW_DATES, L_TOP, L_BOTTOM,
     1                K_DRAW_CHAN)

	L_X = FDV$GETAL( WORK_STR, TERMINATOR)

	SELECT CASE( TERMINATOR)
	    CASE (FDV$K_FK_E6)      !scroll forward
	        L_X = L_BOTTOM + 10
	        IF ( L_X .LE. L_REC_COUNT) THEN
	            L_BOTTOM = L_X
	            L_TOP = L_TOP + 10
	        ELSE
	            L_BOTTOM = L_REC_COUNT
	            L_TOP = L_BOTTOM - 10
	            L_X = FDV$BELL()
	        END IF

	    CASE (FDV$K_FK_E5)      !scroll backwards
	        L_X = L_TOP - 10
	        IF (L_X .GE. 1) THEN
	            L_TOP = L_X
	            L_BOTTOM = L_TOP + 10
	        ELSE
	            L_TOP = 1
	            L_BOTTOM = 10
	            L_X = FDV$BELL()
	        END IF

	    CASE (FDV$K_FK_F10)
	        B_ACTION = 99

	END SELECT

	RETURN
	END


C;;;;;;;;;;
C  Subroutine to load the display records
C;;;;;;;;;;
	SUBROUTINE FTN_LOAD_BROWSE_DISPLAY( DRAW_DATES, L_TOP,
     1                    L_BOTTOM, K_DRAW_CHAN)
	IMPLICIT NONE


	INCLUDE 'MEGA_TEXT_LIB (FDVDEF_FTN)'
        INCLUDE 'MEGA_TEXT_LIB (FTN_MEGA_RECS)'
	INCLUDE '($FORIOSDEF)'

	CHARACTER*8 DRAW_DATES(*)
	BYTE        B_ACTION
	INTEGER*4   L_REC_COUNT, L_TOP, L_BOTTOM, K_DRAW_CHAN

C;;;;;
C	Constants
C;;;;;

	INTEGER*4   K_SCRN_REC_SIZE, K_SCRN_SIZE
	PARAMETER( K_SCRN_REC_SIZE=43, K_SCRN_SIZE=10*K_SCRN_REC_SIZE)

        REAL    ONE_SECOND
        PARAMETER( ONE_SECOND=1.0)

C;;;;;
C	Local variables
C;;;;;
	STRUCTURE /SCREEN_RECORD/
	  UNION
	    MAP
	        CHARACTER*1  F_MARK
	        CHARACTER*10 DRAW_DT
	        CHARACTER*30 NUMBERS
	        CHARACTER*2  MEGA_NO
	    END MAP
	    MAP
	        CHARACTER*(K_SCRN_REC_SIZE) SCRN_LINE
	    END MAP
	  END UNION
	END STRUCTURE


	STRUCTURE /FULL_SCREEN/
	  UNION
	    MAP
	        RECORD /SCREEN_RECORD/SCRN_REC(10)
	    END MAP
	    MAP
	        CHARACTER*(K_SCRN_SIZE) SCRN_STR
	    END MAP
	  END UNION
	END STRUCTURE

	RECORD /FULL_SCREEN/THE_SCREEN
	RECORD /DRAWING_RECORD/DRAW_REC

	INTEGER*4   L_STAT
	INTEGER*4   B_LOC_COUNT, L_X
	INTEGER*1   B_SUB

	CHARACTER*60 MSG_STR
	CHARACTER*9  WORK_NO_STR

C;;;;;
C	Main logic
C;;;;;
	!
	!  blank out the screen data storage area
	!
	THE_SCREEN.SCRN_STR = ' '
	B_LOC_COUNT = 0
	B_SUB = 1

	DO 2100, L_X=L_TOP, L_BOTTOM, 1
2000 	READ (UNIT=K_DRAW_CHAN, KEYGE=DRAW_DATES(L_X), 
     1        IOSTAT=L_STAT, ERR=2996) DRAW_REC

	SELECT CASE( L_STAT)
	    CASE (0)
	        THE_SCREEN.SCRN_REC(B_SUB).DRAW_DT = DRAW_REC.DRAW_DT
	        WRITE (THE_SCREEN.SCRN_REC(B_SUB).MEGA_NO, '(I2)')
     1                    DRAW_REC.MEGA_NO

	        WRITE (THE_SCREEN.SCRN_REC(B_SUB).NUMBERS, 
     1                    '(5(I2, 1X))')
     2                            DRAW_REC.NO_1,
     3                            DRAW_REC.NO_2,
     4                            DRAW_REC.NO_3,
     5                            DRAW_REC.NO_4,
     6                            DRAW_REC.NO_5

	    CASE (FOR$IOS_SPERECLOC)
	        B_LOC_COUNT = B_LOC_COUNT + 1
	        IF (B_LOC_COUNT .LT. 100) THEN
	            CALL LIB$WAIT( ONE_SECOND)
	            GO TO 2000
	        END IF
	    CASE DEFAULT
	        PRINT *, 'Error ', L_STAT, 'Getting first record'
	        GO TO 2999
	END SELECT

	B_SUB = B_SUB + 1

2100	CONTINUE

	CALL FDV$PUTAL( THE_SCREEN.SCRN_STR)
	GO TO 2999

2996	WRITE (WORK_NO_STR, '(I8)') L_STAT
	MSG_STR = 'Error '//WORK_NO_STR//' reading file'
	L_X = FDV$PUTL( MSG_STR)
	L_X = FDV$WAIT()
	MSG_STR = ' '
	L_X = FDV$PUTL( MSG_STR)
	GO TO 2999

2999	RETURN
	END