1   SUB BASIC_DUMP_DRAW_DATA_SUB
    OPTION TYPE=EXPLICIT
    !
    !	BASIC_DUMP_DRAWING_DATA.BAS
    !
    !	Program to dump off a date range of records
    !	From the drawing data IDX file.
    !
    %INCLUDE "MEGA_RECS" %FROM %LIBRARY "MEGA_TEXT_LIB"
    %INCLUDE "LIB$ROUTINES" %FROM %LIBRARY 


    !;;;;;;;;;;
    !	Constants
    !;;;;;;;;;;
    DECLARE BYTE CONSTANT   draw_chan% = 6%
    DECLARE BYTE CONSTANT   rpt_chan% = 12%

    DECLARE LONG CONSTANT   page_size% = 55%

    DECLARE STRING CONSTANT drawing_data$ = "MY_MEGA_FILE"
    DECLARE STRING CONSTANT rpt_file$ = "DRAWING.RPT"

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

    MAP (DRAW_MAP)  DRAWING_RECORD		DRAW_REC


    !;;;;;;;;;;
    !	Local Variables
    !;;;;;;;;;;
    DECLARE BYTE    B_EOF%
    DECLARE WORD    W_X%
    DECLARE LONG    L_X%, L_ERR%, L_DRAW_NO%, L_MISSED%, L_SUB%,    &
		    LINE_CNT%, PAGE_CNT%

    DECLARE STRING  WORK_STR$, LOG_TXT$, BEG_DATE$, END_DATE$


    !;;;;;;;;;;
    !	Main Logic
    !;;;;;;;;;;
99  ON ERROR GOTO 32000	    ! old style error handling

100 GOSUB A900_FILL_IN_LOGICALS

    L_ERR% = 0%
    GOSUB A910_OPEN_FILES

    IF L_ERR% = 0%
    THEN
	GOSUB A930_GET_DATE_RANGE
	GOSUB A940_CREATE_REPORT
    END IF

    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:
        L_ERR% = 0%
        OPEN drawing_data$ FOR INPUT AS FILE #draw_chan%,   &
            ORGANIZATION INDEXED FIXED,                     &
            ALLOW NONE,                                     &
            RECORDTYPE FORTRAN,                             &
            RECORDSIZE drawing_record_size,                 &
	    PRIMARY KEY DRAW_REC::DRAW_DT,		    &
	    MAP DRAW_MAP


912        OPEN rpt_file$ FOR OUTPUT AS FILE #rpt_chan%,    &
                ORGANIZATION SEQUENTIAL VARIABLE,           &
                RECORDTYPE LIST,			    &
		RECORDSIZE 80%

929 RETURN

930 !;;;;;;;;;;
    !	Subroutine to obtain date ranges for report
    !;;;;;;;;;;
 A930_GET_DATE_RANGE:
	PRINT 
	PRINT
	BEG_DATE$ = " "
	INPUT "Enter beginning date format YYYYMMDD: ";BEG_DATE$

	!
	!   Don't allow a null entry to cause an error
	!
	IF BEG_DATE$ <= " "
	THEN
	    BEG_DATE$ = SPACE$(8%)
	END IF

	PRINT
	PRINT
	END_DATE$ = " "
	INPUT "Enter ending date format YYYYMMDD: ";END_DATE$

	IF END_DATE$ <= " "
	THEN
	    END_DATE$ = "999999999"
	END IF

    RETURN

940 !;;;;;;;;;;
    !	Subroutine to actually create the report
    !;;;;;;;;;;
 A940_CREATE_REPORT:

	L_ERR% = 0%
	GET #draw_chan%, KEY # 0% GE BEG_DATE$

	B_EOF% = 0%

	LINE_CNT% = page_size%	    ! force page break on first line
	PAGE_CNT% = 0%

942	WHILE B_EOF% = 0%
	    IF DRAW_REC::DRAW_DT > END_DATE$
	    THEN
		B_EOF% = 1%
	    ELSE
		GOSUB B1000_PRINT_RPT_LINE
		GET #draw_chan%
	    END IF
	NEXT


949 RETURN

1000	!;;;;;;;;;;
	!   Subroutine to print a detail line
	!;;;;;;;;;;
 B1000_PRINT_RPT_LINE:
	    GOSUB C2000_PAGE_HEADING	IF LINE_CNT% >= page_size%

	    LINE_CNT% = LINE_CNT% + 1%

	    PRINT #rpt_chan% USING "    'LLL/'L/'L     ##   ##   ##   ##   ##     ##", &
		LEFT$(DRAW_REC::DRAW_DT,4%), MID$(DRAW_REC::DRAW_DT,5,2),		 &
		RIGHT$( DRAW_REC::DRAW_DT,7%),   					 &
		DRAW_REC::NO_1,								 &
		DRAW_REC::NO_2,								 &
		DRAW_REC::NO_3,								 &
		DRAW_REC::NO_4,								 &
		DRAW_REC::NO_5,								 &
		DRAW_REC::MEGA_NO

	RETURN

2000	!;;;;;;;;;;
	!	Subroutine to print a page heading
	!;;;;;;;;;;
 C2000_PAGE_HEADING:
	    PRINT # rpt_chan%, FF	IF PAGE_CNT% >  0%

	    PAGE_CNT% = PAGE_CNT% + 1%

	    WORK_STR$ = "Drawing Number Report"
	    L_X% = 40% - (LEN( WORK_STR$) / 2%)    ! size of TAB needed to center

	    !;;;;;
	    !	First Heading line
	    !;;;;;
	    PRINT #rpt_chan%, "DATE: ";DATE$(0%);
	    PRINT #rpt_chan%, TAB( L_X%);WORK_STR$;TAB( 71%);"PAGE: ";
	    PRINT #rpt_chan%, FORMAT$( PAGE_CNT%, "###")

	    !;;;;;
	    !	Column Headings
	    !;;;;;
	    PRINT #rpt_chan%, " "
	    PRINT #rpt_chan%, "     Drawing      NO   NO   NO   NO   NO     MEGA"
	    PRINT #rpt_chan%, "      Date         1    2    3    4    5      NO"
	    PRINT #rpt_chan%, "   ------------    --   --   --   --   --    ----"
	    PRINT #rpt_chan%, " "

	    LINE_CNT% = 0%

	RETURN

32000	!;;;;;;;;;;
	!	Old style error handling
	!;;;;;;;;;;

	SELECT ERL
	    CASE = 910%
		L_ERR% = ERR
		PRINT "Unable to open input file"; drawing_data$
		PRINT "Error: ";L_ERR%;" ";ERT$( L_ERR%)
		RESUME 929

	    CASE = 912%
		L_ERR% = ERR
		PRINT "Unable to open report file "; rpt_file$
		PRINT "Error: ";L_ERR%;" ";ERT$( L_ERR%)
		RESUME 929

	    CASE = 930%
		PRINT "Invalid input"
		PRINT "Please re-enter"
		RESUME 930

	    CASE = 940%
		L_ERR% = ERR
		PRINT "Unable to retrieve record GE |";BEG_DATE$;"|"
		PRINT "Error: ";L_ERR%;" ";ERT$( L_ERR%)
		RESUME 949

	    CASE = 942%
		B_EOF% = 1%

		IF ERR <> 11%
		THEN
		    L_ERR% = ERR
		    PRINT "Unable to fetch next input record"
		    PRINT "Error: ";L_ERR%;" ";ERT$( L_ERR%)
		END IF

		RESUME 942

	    CASE ELSE
		ON ERROR GOTO 0
	END SELECT

32767	!  End of module
 PROGRAM_EXIT:

	CLOSE #draw_chan%
	CLOSE #rpt_chan%

        WORK_STR$ = "EDIT/READ " + rpt_file$
        L_X% = LIB$SPAWN( WORK_STR$)

	END SUB