76 lines
2.5 KiB
Plaintext
76 lines
2.5 KiB
Plaintext
|
SUBROUTINE PTBCODE(FVAR,FIELD.NO,sel.val)
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Catalog all BASIC programs
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 1/16/91 7673 DTM Corrected errors, put in motif changes, and finalized
|
||
|
|
* 12/06/88 5086 GPS Correct error due to undefined LINE
|
||
|
|
* 07/25/88 - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* This program was produced in part by SCREENGEN, a proprietary program of
|
||
|
|
* Infocel, Inc., P.O. Box 18305, Raleigh, N.C. 27609 SSA05
|
||
|
|
*
|
||
|
|
*****************************************************************************
|
||
|
|
$OPTIONS A
|
||
|
|
*
|
||
|
|
EQU AM TO CHAR(254) ;* ATTRIBUTE MARK CHARACTER
|
||
|
|
***************************************************************************
|
||
|
|
CODE.REF=''
|
||
|
|
LINE=2
|
||
|
|
heading=""
|
||
|
|
heading=UVREADMSG(073090,"")
|
||
|
|
SELECT FVAR
|
||
|
|
*
|
||
|
|
*** DO AN INSERTION SORT TO GET LOCAL DYNAMIC ARRAY OF CODE FILE KEYS ***
|
||
|
|
*
|
||
|
|
EOI=0
|
||
|
|
LOOP
|
||
|
|
READNEXT ID ELSE EOI=1
|
||
|
|
UNTIL EOI DO
|
||
|
|
IF NUM(ID) THEN
|
||
|
|
LOCATE ID IN CODE.REF<1> BY "AR" SETTING PTR ELSE CODE.REF=INSERT(CODE.REF,PTR,0,0,ID)
|
||
|
|
END ELSE
|
||
|
|
LOCATE ID IN CODE.REF<1> BY "AL" SETTING PTR ELSE CODE.REF=INSERT(CODE.REF,PTR,0,0,ID)
|
||
|
|
END
|
||
|
|
REPEAT
|
||
|
|
*
|
||
|
|
*
|
||
|
|
*** DISPLAY CODE REFERENCE AND DESCRIPTIONS ***
|
||
|
|
*
|
||
|
|
ID=COUNT(CODE.REF,AM)+1
|
||
|
|
IF CODE.REF='' THEN ID=0
|
||
|
|
print.array=""
|
||
|
|
print.count=0
|
||
|
|
FOR I=1 TO ID
|
||
|
|
READV DESC FROM FVAR,CODE.REF<I>,FIELD.NO ELSE DESC=''
|
||
|
|
LINE=MOD(I-1,16)+3
|
||
|
|
print.array<I,1>=CODE.REF<I>
|
||
|
|
print.array<I,2>=DESC
|
||
|
|
print.count += 1
|
||
|
|
NEXT I
|
||
|
|
IF ID = 0 THEN
|
||
|
|
print.array<1>=UVREADMSG(073091,"")
|
||
|
|
print.count=1
|
||
|
|
END
|
||
|
|
CALL *LIST.BOX.B(heading,4,10,print.array,print.count,2,sel.val,0)
|
||
|
|
IF sel.val=-1 THEN RETURN
|
||
|
|
sel.val=print.array<sel.val,1>
|
||
|
|
RETURN
|
||
|
|
END
|