SIR Database Software

Subroutines of the SYSPROC file and how to use them

The TOOLS and other families in the SYSPROC (sirproc.srp) contain various programs and subroutines that may be useful in your programming. This article lists some the members available in the SIR/XS sysproc file (though many of them are available in earlier versions) and shows how to use them. The member SYSPROC.TOOLS.ABOUT in the SIR/XS documents all the members in that family.

In most cases the members are subroutine sources (:T) and executable (:O) pairs with the same family and base member name.

Many of these routines are used by the dialogs in the default main menu.

`SUBROUTINE TOOLS.BUFDLG (buffer_name) RETURNING (rc)`

Displays the text from a buffer as labels in an infobox style dialog.

PROGRAM
INTEGER RC
DELETE BUFFER "MESSAGE"
CREATE BUFFER "MESSAGE"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 1 FROM " This is an example of using"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 2 FROM "    SYSPROC.TOOLS.BUFDLG"
EXECUTE SYSPROC.TOOLS.BUFDLG("MESSAGE") RETURNING (RC)
END PROGRAM

`SUBROUTINE TOOLS.BUFFCOPY (source, target)`

Copies a buffer from source to target, overwriting target if it exists or creating it if it does not.

PROGRAM
INTEGER RC
DELETE BUFFER "MESSAGE"
CREATE BUFFER "MESSAGE"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 1 FROM "This is an example of using BUFFCOPY"
EXECUTE SYSPROC.TOOLS.BUFFCOPY ("MESSAGE","NEW MESSAGE")
END PROGRAM

`SUBROUTINE TOOLS.BUFFEDIT (title, buffer_name, rows, cols)`

Displays a simple buffer editor in a dialog with title and a text box containing the buffer text.

PROGRAM
INTEGER RC
DELETE BUFFER "MESSAGE"
CREATE BUFFER "MESSAGE"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 1 FROM "This is an example of using BUFFEDIT"
EXECUTE SYSPROC.TOOLS.BUFFEDIT ("Edit This..." "MESSAGE",4,50)
END PROGRAM

`SUBROUTINE TOOLS.BUFFFIND (buffer_name, string) RETURNING (line)`

Finds a given line in a sorted buffer using a binary search - returning line number or zero if not found.

PROGRAM
INTEGER RC
DELETE BUFFER "MESSAGE"
CREATE BUFFER "MESSAGE"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 1 FROM "apples"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 2 FROM "bananas"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 3 FROM "needles"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 4 FROM "pawpaw"
EXECUTE SYSPROC.TOOLS.BUFFFIND ("MESSAGE", "needles") RETURNING (RC)
IFTHEN (RC GT 0)
WRITE "Found at " RC
ELSE
WRITE "Not found"
ENDIF
END PROGRAM

`SUBROUTINE TOOLS.BUFFMAKE (buffer_name) RETURNING (rc)`

Creates the buffer if it does not exist but preserve the buffer and contents if it does. If the buffer is created then the return code is 1.

(If you want to create a buffer and want to clear it if it does exist then use

 DELETE BUFFER name
 CREATE BUFFER name

As CREATE BUFFER will give an error if the buffer exists but DELETE BUFFER will not give an error if the buffer does not exist.)

PROGRAM
INTEGER RC
EXECUTE SYSPROC.TOOLS.BUFFMAKE("MESSAGE") RETURNING (RC)
END PROGRAM

`SUBROUTINE TOOLS.BUFFSIZE (buffer_name) RETURNING (lines)`

Returns the number of lines in a buffer using a binary search.

PROGRAM
INTEGER LINES
DELETE BUFFER "MESSAGE"
CREATE BUFFER "MESSAGE"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 1 FROM "apples"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 2 FROM "bananas"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 3 FROM "needles"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 4 FROM "pawpaw"
EXECUTE SYSPROC.TOOLS.BUFFSIZE("MESSAGE") RETURNING (LINES)
WRITE "MESSAGE is " LINES " lines long"
END PROGRAM

`SUBROUTINE TOOLS.BUFFSORT (buffer_name, target, ord)`

Sorts a buffer into target with ord being "A" or "D".

PROGRAM
INTEGER LINES
DELETE BUFFER "MESSAGE"
CREATE BUFFER "MESSAGE"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 1 FROM "pawpaw"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 2 FROM "bananas"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 3 FROM "needles"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 4 FROM "apples"
EXECUTE SYSPROC.TOOLS.BUFFSORT("MESSAGE","NEW MESSAGE","A")
EXECUTE SYSPROC.TOOLS.BUFFEDIT("Sorted","NEW MESSAGE",6,30)
END PROGRAM

`SUBROUTINE TOOLS.BUFRDLG (buffer_name) RETURNING (rc)`

Displays the text from a buffer in a dialog. This is called the same way as BUFDLG but the display is different and you can use some HTML tags in the buffer source.

PROGRAM
INTEGER RC
DELETE BUFFER "MESSAGE"
CREATE BUFFER "MESSAGE"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 1 FROM "<center>An example of using<br>"
PUT LINE TO BUFFER "MESSAGE" NUMBERED 2 FROM "<b>SYSPROC.TOOLS.BUFRDLG</b></center>"
EXECUTE SYSPROC.TOOLS.BUFRDLG("MESSAGE") RETURNING (RC)
END PROGRAM

`SUBROUTINE TOOLS.CNTRLPOP (id, type, opt1) RETURNING (num)`

CNTRLPOP populates a dialog list or choice control with the named type. OPT1 can contain more information. The TYPE parameter can be one of the following strings:

"DATABASE" - lists connected databases
"RECORD" - Lists records in the default database (if OPT1 is "CIR" then CIR is included)
"VARS" - Variables in record named by OPT1
"CVARS" - Variables including common in record named by OPT1
"INDEXES" - Secondary indexes in record named by OPT1
"TABFILE" - Connected tabfiles
"TABLE" - Tables in the tabfile named by OPT1
"COLUMN" - Columns in the tabfile.table named by OPT1
"TINDEXES" - Indexes on the tabfile.table named by OPT1
"FAMILY" - Families in the default procfile
"MEMBER" - Members in the default family (OPT1 can be any/all the letters TOEV to list specific types of members)
"ATTRIB" - Lists defined file attributes
"ATTRDSN" - Lists filenames from the attributes
"GLOBALN" - Lists defined global names
"GLOBALV" - Lists defined global values
"BUFFERS" - Lists buffers
"BUFFLINE" - Lists the text lines from the buffer named by OPT1

SET PROCFILE SYSPROC
SET FAMILY TOOLS
PROGRAM
INTEGER*2 M_ID, M_ARG1, M_ARG2
INTEGER NUM
DIALOG "The TOOLS Family"
LIST 1  ,   0, 8,   0,  80, 0
INITIAL
EXECUTE SYSPROC.TOOLS.CNTRLPOP (1,"MEMBER","TE") RETURNING (NUM)
END INITIAL
MESSAGE ALL M_ID, M_ARG1, M_ARG2
IF (M_ID EQ 0) EXIT MESSAGE
END MESSAGE
END DIALOG
END PROGRAM

`SUBROUTINE TOOLS.CNTRLSRT (id, order)`

Sorts the items in a dialog list with control id ID. ORDER is 0 (invert), 1 (ascending) -1 (descending). The current selection is maintained.

PROGRAM
INTEGER*2 M_ID, M_ARG1, M_ARG2
INTEGER*1 ID_00001; PRESET ID_00001 (1 )
DIALOG "Sort A Control"
POSTYPE 1
LIST     ID_00001,   0,  86,   0,  80, 0
INITIAL
APPEND ITEM ID_00001,"TESTING"
APPEND ITEM ID_00001,"SORT"
APPEND ITEM ID_00001,"CONTROL"
APPEND ITEM ID_00001,"USING"
APPEND ITEM ID_00001,"A"
APPEND ITEM ID_00001,"TOOLS"
APPEND ITEM ID_00001,"SUBROUTINE"
EXECUTE SYSPROC.TOOLS.CNTRLSRT(ID_00001,1)
END INITIAL
MESSAGE ALL M_ID, M_ARG1, M_ARG2
IF (M_ID EQ 0) EXIT MESSAGE
END MESSAGE
END DIALOG
END PROGRAM

`SUBROUTINE TOOLS.COLRIMG (id, height, width, hexin)`

Sets an image (or button in SIR/XS) control to the given hex colour. Height and Width determine the height and width (in pixels) of the bitmap created to display in the image or button.

PROGRAM
INTEGER*2 M_ID, M_ARG1, M_ARG2
INTEGER*1 ID_00001; PRESET ID_00001 (1 )
DIALOG "Green"
POSTYPE 1
IMAGE    ID_00001  ,   0,  21,   0,  80, 1
INITIAL
EXECUTE SYSPROC.TOOLS.COLRIMG (ID_00001,40,120,"#008000")
END INITIAL
MESSAGE ALL M_ID, M_ARG1, M_ARG2
IF (M_ID EQ 0) EXIT MESSAGE
END MESSAGE
END DIALOG
END PROGRAM

`SUBROUTINE TOOLS.COLRPICK (hexin) RETURNING (hexout)`

Displays a small dialog with various methods of selecting a colour. Hexin and Hexout are in the format "#FFFFFF" - a return value of "" indicates "No Colour" was selected. This only works in SIR/XS.

PROGRAM
STRING COLOUR
EXECUTE SYSPROC.TOOLS.COLRPICK("#FF0000")
RETURNING (COLOUR)
END PROGRAM

`SUBROUTINE TOOLS.DATEPICK (title, default) RETURNING (selected, rc)`

Displays a date selector - pass a title and default date and it returns selected date integer and a return code -1 = cancel; 0 = ok

PROGRAM
DATE SELECTED ("DD MMM YYYY")
INTEGER RC
EXECUTE SYEPROC.TOOLS.DATEPICK ("Pick A Date...",TODAY(0)) RETURNING (SELECTED,RC)
END PROGRAM

`SUBROUTINE TOOLS.FILENAME (filename) RETURNING (path, name, ext)`

This routine takes a filename and returns parts. If filename is a path it will return the parent directory for the path.

PROGRAM
STRING*256 FILENAME PATH NAME
STRING*8   EXT
INTEGER RC
DISPLAY OPENBOX 'Filename','All Files(*.*)|*.*|','',1 RESPONSE RC,FILENAME
IFTHEN (RC GT 0)
EXECUTE SYSPROC.TOOLS.FILENAME (FILENAME) RETURNING (PATH,NAME,EXT)
WRITE PATH / NAME / EXT
ENDIF
END PROGRAM

`SUBROUTINE TOOLS.LONGWRAP (long_string, width, buffer) RETURNING (lines)`

Takes a long string and wraps it into a buffer so that no line is longer than the given width. The number of lines in the buffer is returned.

PROGRAM
INTEGER RC
STRING*4000 LONGSTR
COMPUTE LONGSTR =
 "Call me Ishmael. Some years ago- never  mind how long precisely- "
 + "having little or no money in my purse, and nothing particular "
 + "to interest me on shore, I thought I would sail about a little "
 + "and see the watery part of the world."
EXECUTE SYSPROC.TOOLS.BUFFMAKE ("WRAPPED") RETURNING (RC)
EXECUTE SYSPROC.TOOLS.LONGWRAP (LONGSTR,20,"WRAPPED") RETURNING (RC)
EXECUTE SYSPROC.TOOLS.BUFDLG ("WRAPPED") RETURNING (RC)
END PROGRAM

`SUBROUTINE TOOLS.NAMEFILE (name, ext) RETURNING (filename)`

This routine takes a SIR name and extension and returns a valid filename.

PROGRAM
INTEGER RC
STRING*256 FILENAME
EXECUTE SYSPROC.TOOLS.NAMEFILE ("COMPANY", "exp") RETURNING (FILENAME)
WRITE FILENAME
END PROGRAM

`SUBROUTINE TOOLS.ODBCLIST RETURNING (database)`

Displays a dialog listing the ODBC data sources available and returns the data source name selected.

PROGRAM
STRING*80 SOURCE
EXECUTE SYSPROC.TOOLS.ODBCLIST RETURNING (SOURCE)
WRITE SOURCE
END PROGRAM

`SUBROUTINE TOOLS.RECSTAT (recnum) RETURNING (status)`

Returns the record status for RECNUM: status is: -1 = the record does not exist; 0 = the record exists but has no data; 1 = record exists with data; 9 = the record is locked pending restructure.

PROGRAM
INTEGER RC
EXECUTE SYSPROC.TOOLS.RECSTAT(2) RETURNING (RC)
WRITE "Status = " RC
END PROGRAM

`SUBROUTINE TOOLS.SCRFILE (mask) RETURNING (filename,rc)`

This routine returns a non-existent scratch file name based on MASK (or MASK.EXT). The filename will be MASKnnnnn.EXT and will include the temp directory path name if it is defined. EXT defaults to "tmp" and MASK defaults to "SIR". You can then open the file for write without overwriting an existing file. RC contains -1 if it cannot find a non-existent filename.

PROGRAM
INTEGER RC
STRING*80 SCR
EXECUTE SYSPROC.TOOLS.SCRFILE ("TEST.tmp") RETURNING (SCR,RC)
WRITE SCR
END PROGRAM

`SUBROUTINE TOOLS.SIRNAME (name, len) RETURNING (newname, rc)`

Takes a string name and checks if it is a valid sir name. In SIR2002 this would check if the name started with an alphabetic character and contained only alphanumeric and special ($#_@) characters and was no longer than LEN characters. In any case would return a valid name with RC = 0 if it was unchanged.

In SIR/XS the naming rules are more liberal. Names can have any characters but need to be enclosed in curly brackets if they are non-standard names.

if it is wrapped in quotes or {}s then it is taken literally and put in {}s
if it contains special characters it is wrapped in {}
if it contains a mix of case it is wrapped in {}
if it does not start with an alpha it is wrapped in {}

PROGRAM
STRING NEWNAME
EXECUTE SYSPROC.TOOLS.SIRNAME("!^235 Z",8) RETURNING (NEWNAME,RC)
WRITE NEWNAME
END PROGRAM

`SUBROUTINE SYSPROC.TOOLS.SOUNDEX (longname) RETURNING (sound)`

Takes a string and returns a short string code. Based on "An Algorithm For Variable Length Proper-Name Compression" James L Dolby Journal Of Library Automation Volume 3/4 December 1970

This is not the "SOUNDEX" algorithm.

This might be used with a secondary index on the SOUND of words or names. When a user enters a new name then a list of similar sounding words/names could be displayed.

PROGRAM
STRING NAME SOUND
COMPUTE NAME = "CHICKEN SOUP"
EXECUTE SYSPROC.TOOLS.SOUNDEX(NAME) RETURNING (SOUND)
WRITE SOUND
COMPUTE NAME = "COKEN SOAP"
EXECUTE SYSPROC.TOOLS.SOUNDEX(NAME) RETURNING (SOUND)
WRITE SOUND
END PROGRAM

`SUBROUTINE TOOLS.VERIFY (patch) RETURNING (n,c,w)`

Verifies the database and return numbers of non-correctable errors, correctable errors and warnings. If patch is 1 the verify first attempts the patch and then does another verify to confirm that it worked.

This is a handy one to run at the start of a batch check and backup process.

PROGRAM
INTEGER N C W
EXECUTE SYSPROC.TOOLS.VERIFY (0) RETURNING (N,C,W)
IFTHEN (N EQ 0 AND C GT 0)
EXECUTE SYSPROC.TOOLS.VERIFY (1) RETURNING (N,C,W)
ENDIF
IFTHEN (SUM(N,C,W) EQ 0)
WRITE "All OK..."
ENDIF
END PROGRAM

`SUBROUTINE SYSPROC.MENU.EDITOR (pqlfile,type)`

Starts the "internal" SIR editor on the named source. If type is 1 then the PQLFILE is a file; if type is 2 then it is a member; if type is 3 then PQLFILE is a buffer.

PROGRAM
EXECUTE SYSPROC.MENU.EDITOR ("SYSPROC.MENU.EDITOR",2)
END PROGRAM

So, as you see there are many potentially useful routines here. Please feel free to use them and any others not mentioned here. Copy the source code and modify it for your own needs if you wish. The PQL source code is included deliberately and is not subject to copyright.

Note: if you modify the procedures in the sysproc file then you may lose them when a revision is released - or the revised procfile may not overwrite your procfile (if yours is newer) so you will not receive the updated procfile.