RUN NAME COMPANY EXPORT TASK NAME INITIALIZATION NEW FILE COMPANY PASSWORD COMPANY JOURNAL ON READ SECURITY (10) LOW (20) MIDDLE (30) HIGH WRITE SECURITY (10) LOW (20) MIDDLE (30) HIGH CASE ID ID (A) N OF CASES 1000 RECS PER CASE 1023 MAX INPUT COLS 80 RECTYPE COLS 5 MAX REC TYPES 30 MAX REC COUNT 100 DOCUMENT This database contains employee information within three Record Types: Record Type 1 - Employee personnel information - One Record per Employee Record Type 2 - Employee occupation information - One Record per occupation Record Type 3 - Employee performane review information - One Record per review TASK NAME Standard Variable Definitions STANDARD SCHEMA DATA LIST POSITION * (I1) SALARY * (I2) SALDATE * (DATE'MMIDDIYY') YN * (I1) VAR RANGES POSITION (1 18) SALARY (600 9000) VAR SECURITY SALARY (30,30) MISSING VALUES POSITION TO SALDATE (BLANK) VALID VALUES YN (1 2) VALUE LABELS POSITION (1)'Clerk' (2)'Secretary' (3)'Sr Secretary' (4)'Laborer' (5)'Technician' (6)'Sr Technician' (7)'Designer' (8)'Sr Designer' (9)'Chemist' (10)'Sr Chemist' (11)'Engineer' (12)'Sr Engineer' (13)'Administrator' (14)'Sr Administrator' (15)'Accountant' (16)'Sr Accountant' (17)'Director' (18)'President' VAR LABEL POSITION 'Position' SALARY 'Salary' SALDATE 'Date Salary Set' END SCHEMA TASK NAME Record Definition for CIR RECORD SCHEMA 0 CIR DATA LIST ID * (I2) MISSING VALUES ID (BLANK) VAR LABEL ID 'Identification Number' END SCHEMA TASK NAME Record Definition for EMPLOYEE Record Number 1 RECORD SCHEMA 1 EMPLOYEE 'Employee demographic information' DOCUMENT Record Type 1 contains demographic information. There is one record per employee. The record contains the employee ID, name, gender, marital status, social security number, date of birth, educationn level to date, marital status, and number of dependents. In addition, the record contains the current position level and salary and the date on which the salary was last changed. MAX REC COUNT 1 DATA LIST ID 1 - 4 (I2) NAME 6 - 30 (A25) GENDER 31 (I1) MARSTAT 32 (I1) SSN 33 - 43 (A11) BIRTHDAY 44 - 51 (DATE'MMIDDIYY') EDUC 52 (I1) NDEPENDS 53 - 54 (I1) CURRPOS 55 - 56 (I1) SALARY 57 - 60 (I2) CURRDATE 61 - 68 (DATE'MMIDDIYY') STANDARD VARS CURRPOS AS POSITION SALARY VAR RANGES GENDER TO MARSTAT (1 2) EDUC (1 6) NDEPENDS (0 20) MISSING VALUES NAME TO NDEPENDS (BLANK) CURRDATE (BLANK) VALUE LABELS GENDER (1)'Male' (2)'Female' MARSTAT (1)'Married' (2)'Not married' EDUC (1)'Elementary' (2)'High School' (3)'Some University' (4)'B.Sc. or B.A.' (5)'M.S.' (6)'Ph.D.' VAR LABEL NAME 'Name' GENDER 'Gender' MARSTAT 'Marital status' SSN 'Social security number' BIRTHDAY 'Date of birth' EDUC 'Education level' NDEPENDS 'Number of dependents' CURRPOS 'Current position level' CURRDATE 'Current salary date' END SCHEMA TASK NAME Record Definition for OCCUP Record Number 2 RECORD SCHEMA 2 OCCUP DOCUMENT Record Type 2 contains employee occupational information including position level, starting date in position level, monthly starting salary, and division. Type 2 records are uniquely identified by ID and Position. - One Record per review KEY FIELDS POSITION(A) MAX REC COUNT 100 REC SECURITY 20 20 DATA LIST ID 1 - 4 (I2) POSITION 6 - 7 (I1) STARTDAT 8 - 15 (DATE'MMIDDIYY') STARTSAL 17 - 20 (I2) DIVISION 21 (I1) STANDARD VARS POSITION VAR RANGES STARTSAL (600 9000) DIVISION (1 3) MISSING VALUES STARTDAT TO DIVISION (BLANK) VALUE LABELS DIVISION (1)'Chemical' (2)'Corporate' (3)'Manufacturing' VAR LABEL STARTDAT 'Starting date this level' STARTSAL 'Starting salary this level' DIVISION 'Division' END SCHEMA TASK NAME Record Definition for REVIEW Record Number 3 RECORD SCHEMA 3 REVIEW DOCUMENT This record type includes employee performance information an contain review date, performance rating, new salary, and supervisor ID. Type 3 records are uniquely identified by ID, Position, and Revdate. Records are sorted in ascending order by ID and Position and in descending order by Revdate. KEY FIELDS POSITION(A) REVDATE(A) MAX REC COUNT 100 REC SECURITY 30 30 DATA LIST ID 1 - 4 (I2) POSITION 6 - 7 (I1) REVDATE 8 - 15 (DATE'MMIDDIYY') RATING 16 (I1) NEWSAL 17 - 20 (I2) IDSUPER 21 - 24 (I2) STANDARD VARS POSITION VAR RANGES RATING (1 5) NEWSAL (600 9000) MISSING VALUES REVDATE TO IDSUPER (BLANK) VALUE LABELS RATING (1)'Unacceptable' (2)'Poor' (3)'Acceptable' (4)'Good' (5)'Very Good' VAR LABEL REVDATE 'Evaluation date' RATING 'Evaluation index' NEWSAL 'Monthly salary' IDSUPER 'Supervisor ID' END SCHEMA STRING LENGTH 32 CREATE DBINDEX NAME ON EMPLOYEE (NAME) CREATE DBINDEX BIRTHDAY ON EMPLOYEE (BIRTHDAY) CREATE DBINDEX EDUC ON EMPLOYEE (EDUC,GENDER) CREATE DBINDEX EDUCID ON EMPLOYEE (EDUC,GENDER,ID) DATA FILES "COMPANY1.SR3" FROM (10) "COMPANY2.SR3" FROM (15) "COMPANY3.SR3" REMARK 'Begin import of members' PROCEDURE {CONFERENCE 2007}.{01 ENHANCED}:T (155098,50538) |Last amended Jun 06, 2007,14:02:18 program compute this_is_a_variable="a standard variable" write this_is_a_variable write '------------------' compute THIS_IS_A_VARIABLE="A STANDARD VARIABLE" write this_is_a_variable write THIS_IS_A_VARIABLE write '------------------' compute {this_is_a_variable}="a standard variable" write this_is_a_variable write THIS_IS_A_VARIABLE write {this_is_a_variable} write '------------------' end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{02 DOREPEAT}:T (155098,51144) |Last amended Jun 06, 2007,14:12:24 program compute fred='variable contents' do repeat x=Fred,"Fred",$Fred$,'Fred' write "--x--" x end repeat end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{03 PREFIX}:T (155107,51759) |Last amended Jun 15, 2007,14:22:39 retrieval compute start='start' process cases list =1 get vars all prefix 'EMPLOYEE_' get vars all suffix '_employee' process rec 1 get vars all prefix 'EMPLOYEE_' get vars all suffix '_employee' compute stop='stop' do repeat var=start to stop write 'var='var end repeat end process rec end process cases end retrieval END PROCEDURE PROCEDURE {CONFERENCE 2007}.{04 CGITABS}:T (155098,50605) |Last amended Jun 06, 2007,14:03:25 C** This program is intended to be run from a web browser C** as a demonstration of displaying SIR data across the web C** It writes to a special filename CGI and has the keyword HTML C** on the TABULATE procedures retrieval integer*1 age, income , region value labels age (1) 'Young' (2) 'Old' / income (1) 'Rich' (2) 'Poor' / region (1) 'North' (2) 'South' / process cases record is employee . region = 1 . if (id gt 10) region = 2 . get vars gender marstat salary . income = 2 . if (salary gt 2600) income = 1 . age = 1 if ((today(0)-birthday)/365 gt 40) age = 2 . perform procs end rec is end cases tabulate wafer = (age) stub = (income) header = (marstat then region) filename=cgi html tabulate stub = (age by income) header = (marstat) filename=cgi html c tabulate stub = (age.t) header = (marstat%x by x.t) percent = x 'pct' filename=cgi html c tabulate header = (salary by age by gender) stub = (marstat ) html c tabulate stub = (age) header = (gender then (salary by gender)) html c tabulate stub = (marstat) header = (age by (gender then salary)) html c tabulate header = ((age then income) by gender) html c tabulate header = (age by income then gender) html c tabulate header = (age by (income then gender)) html end retrieval END PROCEDURE PROCEDURE {CONFERENCE 2007}.{05 STANDARD}:T (155098,50613) |Last amended Jun 06, 2007,14:03:33 program compute nr=nrecs(0) write 'Max records ' nr do repeat rt=-2,-1,0,1,2,3,$nr+1$ compute nvars=nvars(rt) write 'Number of variables in rectype rt is ' nvars for i=1,nvars write 'Variable ' i ' is '[varname(rt,i)] end for end repeat end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{06 SIRUSER}:T (155098,53754) |Last amended Jun 06, 2007,14:55:54 Program compute dummy=siruser('Dave doulton') end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{07 JOURNAL}:T (155098,53765) |Last amended Jun 06, 2007,14:56:05 retrieval noautocase date sdate,edate('dd/mm/yyyy') time stime,etime('hh:mm:ss') integer jtype value labels jtype (-1)Journal Data header(-2)Unload Schema header(-3)Unload Data header (-4)Journal Schema header(-5)User header (1) New record written. (2)Before existing record updated.(3)After existing record updated. (4) Before Record deleted PROCESS JOURNAL date=sdate enddate=edate time=stime endtime=etime level=reclev record=rectype type=jtype user=username . write 'Between ' sdate stime ' and ' edate etime/ ' at update level ' reclev ' record type ' rectype [trim(vallab(jtype))] /'User was 'username journal record is 1 write 'Martstat=' marstat end journal record END PROCESS JOURNAL end retrieval END PROCEDURE PROCEDURE {CONFERENCE 2007}.{08 ROLLBACK}:T (155108,61037) |Last amended Jun 16, 2007,16:57:17 retrieval case is 1 rec is 1 get vars marstat write 'marstat is ' marstat ' at level ' [updlevel(0)] end rec is end case is end retrieval retrieval update upstat case is 1 rec is 1 get vars marstat ifthen(marstat eq 1) compute marstat=2 else marstat=1 endif end rec is end case is end retrieval retrieval case is 1 rec is 1 get vars marstat write 'marstat is ' marstat ' at level ' [updlevel(0)] get vars marstat compute u=updlevel(0) end rec is end case is write u compute dummy=Globaln('lev',u) end retrieval c c remark 'rollback to level ' journal rollback update= c retrieval case is 1 rec is 1 get vars marstat write 'marstat is ' marstat ' at level ' [updlevel(0)] end rec is end case is end retrieval END PROCEDURE PROCEDURE {CONFERENCE 2007}.{09 XML}:T (155098,53788) |Last amended Jun 06, 2007,14:56:28 RETRIEVAL /PROGRESS . PROCESS CASES ALL . GET VARS ID . PROCESS RECORD EMPLOYEE . GET VARS NAME BIRTHDAY SALARY . PERFORM PROCS . END PROCESS RECORD . END PROCESS CASES XML SAVE FILE FILENAME = "EXAMPLE.XML" ROOT = 'company' BREAK = ID (TAG = 'person' ATTRIBUTES = (name salary birthday)) SORT = ID SCHEMA END RETRIEVAL END PROCEDURE PROCEDURE {CONFERENCE 2007}.{10 DEBUG}:T (155107,54767) |Last amended Jun 15, 2007,15:12:47 C*** Use the debugger to debug this program - choose the module SYSTEM.DEBUG C** when in the debugger SUBROUTINE system.FMLNAME (NAME) RETURNING (FNAME,MINIT,LNAME) REPLACE NODATABASE DEBUG DYNAMIC . STRING*50 NAME . STRING FNAME MINIT LNAME . INTEGER FSPACE LSPACE . SET FNAME MINIT LNAME ("") . COMPUTE FSPACE = ABS(SRST(NAME," ")) . COMPUTE LSPACE = LEN(NAME) + 1 - ABS(SRST(REVERSE(NAME)," ")) . COMPUTE FNAME = SBST(NAME,1,FSPACE-1) . COMPUTE LNAME = SBST(NAME,LSPACE+1,LEN(NAME)-LSPACE) . IF (LSPACE NE FSPACE) COMPUTE MINIT = SBST(NAME,FSPACE+1,1) END SUBROUTINE RETRIEVAL DEBUG . STRING FNAME MINIT LNAME . PROCESS CASES . PROCESS RECORD 1 . EXECUTE SUBROUTINE FMLNAME (NAME) RETURNING (FNAME,MINIT,LNAME) . WRITE NAME . WRITE FNAME " / " MINIT " / " LNAME . END RECORD . END CASE END RETRIEVAL END PROCEDURE PROCEDURE {CONFERENCE 2007}.{11 PQLSERVER}:T (155099,52696) |Last amended Jun 07, 2007,14:38:16 || Generated by DP - don't edit anything outside |{...|} |{ Document This program lets you remotely administer a PQLServer. Enter the server name (or server:port) and press connect. If the server has been started with an admin password then enter that password. A list of other users (excluding you) is displayed. |} |{ Header PROGRAM |} integer*2 m_id, m_arg1, m_arg2 integer*1 IDSTATIC; preset IDSTATIC (-1) integer*1 IDCLOSE ; preset IDCLOSE ( 0) integer*1 IDSERV ; preset IDSERV (1 ) integer*1 IDPWD ; preset IDPWD (2 ) integer*1 IDCON ; preset IDCON (3 ) integer*1 IDMYNAME ; preset IDMYNAME (4 ) integer*1 IDNUSER ; preset IDNUSER (5 ) integer*1 IDUSERS ; preset IDUSERS (6 ) integer*1 IDSTATUS ; preset IDSTATUS (7 ) integer*1 IDUKILL ; preset IDUKILL (8 ) integer*1 IDAKILL ; preset IDAKILL (9 ) integer*1 IDNSHUT ; preset IDNSHUT (10 ) integer*1 IDSHUT ; preset IDSHUT (11 ) integer*1 IDDCON ; preset IDDCON (12 ) integer*1 IDCS ; preset IDCS (13 ) integer*1 IDSS ; preset IDSS (14 ) integer*1 IDFILE ; preset IDFILE (15 ) integer*1 IDBROWSE ; preset IDBROWSE (16 ) integer*1 IDEDIT ; preset IDEDIT (17 ) integer*1 IDRUN ; preset IDRUN (18 ) |{ Prologue INTEGER CID RC STRING*50 SERVER PASSWORD STRING*256 file text |} dialog "PQL Server Administrator" |{ Controls postype 1 label IDSTATIC , 4, 0, 41, "&Server:" edit IDSERV , 0, 45, 138, 0, 0 label IDSTATIC , 17, 0, 41, "&Password:" edit IDPWD , 13, 45, 138, 1, 0 button IDCON , 0, 187, 52, 1, "&Connect" label IDMYNAME , 26, 0, 238, "" label IDNUSER , 39, 0, 108, "Other &Users:" list IDUSERS , 49, 69, 2, 146, 0 label IDSTATUS , 121, 0, 236, "" button IDUKILL , 49, 152, 87, 0, "D&isconnect User" button IDAKILL , 68, 152, 87, 0, "Disconnect All Users" button IDNSHUT , 87, 152, 87, 0, "Shutdown Server &Nologins" button IDSHUT , 106, 152, 87, 0, "Shutdown Server N&OW!" button IDDCON , 13, 187, 52, 0, "&Disconnect" label IDSTATIC , 137, 0, 94, "Run a program..." radio IDCS , 135, 97, 62, "Client Side" radio IDSS , 135, 161, 58, "Server Side" edit IDFILE , 147, 2, 221, 0, 0 button IDBROWSE , 147, 224, 15, 0, ">>" button IDEDIT , 164, 10, 37, 0, "&Edit" button IDRUN , 164, 102, 37, 0, "&Run" button IDCLOSE , 164, 197, 37, 0, "Close" |} initial |{ Attribs |} |{ Init SET CID (-1) EXECUTE SUBPROCEDURE REFRESH ENABLE TIMER 30 |} end initial message ALL m_id, m_arg1, m_arg2 ifthen (m_id eq IDCON ) |< IDCON COMPUTE SERVER = GETTXT(IDSERV) IF (SRST(SERVER,":") EQ 0) COMPUTE SERVER=TRIM(SERVER)+":4000" IFTHEN(EXISTS(GETTXT(IDPWD))) COMPUTE PASSWORD = GETTXT(IDPWD) ELSE COMPUTE PASSWORD='' ENDIF COMPUTE CID = SERLOG(SERVER,PASSWORD) IFTHEN (CID LE 0) . DISPLAY ERRBOX "Error logging in "+ format(cid) ENDIF EXECUTE SUBPROCEDURE REFRESH |> next message endif ifthen (m_id eq IDUSERS ) |< IDUSERS EXECUTE SUBPROCEDURE UINFO |> next message endif ifthen (m_id eq IDUKILL ) |< IDUKILL IFTHEN(EXISTS(GETTXT(IDPWD))) COMPUTE PASSWORD = GETTXT(IDPWD) ELSE COMPUTE PASSWORD='' ENDIF COMPUTE I = NUMBR(SBST(GETTXT(IDUSERS),1,4)) DISPLAY YESNOBOX "Are you sure you want to disconnect client number "+format(i) RESPONSE RC IF (RC EQ 1) COMPUTE DUMMY = SERADMIN (3,I,PASSWORD) IF (DUMMY LT 0) DISPLAY ERRBOX "Failed to disconnect - check password" EXECUTE SUBPROCEDURE REFRESH |> next message endif ifthen (m_id eq IDAKILL ) |< IDAKILL IFTHEN(EXISTS(GETTXT(IDPWD))) COMPUTE PASSWORD = GETTXT(IDPWD) ELSE COMPUTE PASSWORD='' ENDIF DISPLAY YESNOBOX "Are you sure you want to disconnect all clients" RESPONSE RC IFTHEN (RC EQ 1) FOR J = 1,GETNITEM(IDUSERS) COMPUTE I = NUMBR(SBST(GETITXT(IDUSERS,J),1,4)) COMPUTE DUMMY = SERADMIN (3,I,PASSWORD) IFTHEN (DUMMY LT 0) DISPLAY ERRBOX "Failed to disconnect - check password" EXIT FOR END IF END FOR ENDIF EXECUTE SUBPROCEDURE REFRESH |> next message endif ifthen (m_id eq IDNSHUT ) |< IDNSHUT IFTHEN(EXISTS(GETTXT(IDPWD))) COMPUTE PASSWORD = GETTXT(IDPWD) ELSE COMPUTE PASSWORD='' ENDIF COMPUTE DUMMY = SERADMIN (7,0,PASSWORD) IF (DUMMY LT 0) DISPLAY ERRBOX "Failed - check password" |> next message endif ifthen (m_id eq IDSHUT ) |< IDSHUT IFTHEN(EXISTS(GETTXT(IDPWD))) COMPUTE PASSWORD = GETTXT(IDPWD) ELSE COMPUTE PASSWORD='' ENDIF COMPUTE DUMMY = SERADMIN (6,0,PASSWORD) IF (DUMMY LT 0) DISPLAY ERRBOX "Failed - check password" |> next message endif ifthen (m_id eq IDDCON ) |< IDDCON COMPUTE CID = SERLOG("","") SET CID (-1) EXECUTE SUBPROCEDURE REFRESH |> next message endif ifthen (m_id eq IDFILE ) |< IDFILE . execute subprocedure chkfile |> next message endif ifthen (m_id eq IDBROWSE ) |< IDBROWSE . DISPLAY OPENBOX 'Select Text File', 'Sir PQL (*.pql)|*.pql|All Files(*.*)|*.*|', 'pql',0 RESPONSE rc,file . ifthen (rc gt 0) . set item IDFILE,file . endif . execute subprocedure chkfile |> next message endif ifthen (m_id eq IDEDIT ) |< IDEDIT . compute file = trimlr(gettxt(IDFILE)) . IFTHEN (SYSTEM(42) EQ 2) . EXECUTE SUBROUTINE SYSPROC.MENU.EDITOR(file,1) DYNAMIC . ELSE . COMPUTE text = 'EDITFILE "' + file +'" /CLEAR' . EXECUTE DBMS text . ENDIF |> next message endif ifthen (m_id eq IDRUN ) |< IDRUN . SET I (0) CHAR (0) . COMPUTE FILE = TRIMLR(GETTXT(IDFILE)) . IFTHEN (GETICHK(IDCS) EQ 1) . OPEN TEMP DSNVAR = FILE / READ / IOSTAT=RC / LRECL = 256 . IFTHEN (RC EQ 0) . LOOP . READ (TEMP,IOSTAT=RC) TEXT(A256) . IFNOT (RC EQ 0) EXIT LOOP . COMPUTE n = SERSEND (TEXT) . END LOOP . CLOSE TEMP . ENDIF . ELSE . COMPUTE n = SERSEND ('INCLUDE FILE "'+FILE+'"') . ENDIF . COMPUTE RC = SEREXEC (1) . IFTHEN(RC<=0) . COMPUTE RC=SERTEST(1) . WHILE (RC NE 0) . COMPUTE RC=SERTEST(1) . END WHILE . COMPUTE OLINES = SERLINES(0) . FOR I=1,OLINES . COMPUTE TEXT = SERGET (0) . WRITE TEXT . ROF . ENDIF |> next message endif if (m_id eq 0) exit message end message message TIMER |{ Timer . EXECUTE SUBPROCEDURE REFRESH . ENABLE TIMER 30 |} end message end dialog |{ Exit IF (CID GT 0) COMPUTE CID = SERLOG("","") |} |{ Footer SUBPROCEDURE REFRESH COMPUTE POS = GETPOS(IDUSERS) IFTHEN (CID GT 0) REMOVE ALL IDUSERS DISABLE ITEM IDCON ENABLE ITEM IDDCON ENABLE ITEM IDMYNAME ENABLE ITEM IDDCON ENABLE ITEM IDSHUT ENABLE ITEM IDNSHUT ENABLE ITEM IDUSERS ENABLE ITEM IDFILE ENABLE ITEM IDBROWSE ENABLE ITEM IDCS ENABLE ITEM IDSS DISABLE ITEM IDUKILL DISABLE ITEM IDAKILL compute nusers = SERADMIN(1,0,PASSWORD) ifthen (nusers < 1) write "nuser rc = " nusers else compute me = SERADMIN (2,0,PASSWORD) SET ITEM IDNUSER, FORMAT(nusers-1)+" Other &Users:" FOR I = 1,nusers compute uid = SERADMIN (2,i,PASSWORD) IF (me EQ uid) NEXT FOR if (uid gt 0) APPEND ITEM IDUSERS,FORMAT(UID,4)+" "+ SERADMIS (1,UID,PASSWORD) END FOR endif EXECUTE SUBPROCEDURE UINFO SET ITEM IDMYNAME,"????????" SET ITEM IDMYNAME," You are logged in as client number " +FORMAT(SERADMIN (2,0,PASSWORD))+", "+SERADMIS (1,0,PASSWORD) IFTHEN (GETNITEM(IDUSERS) GT 0) ENABLE ITEM IDUKILL ENABLE ITEM IDAKILL ENDIF IF (POS GT 0 AND POS LE GETNITEM(IDUSERS)) SELECT ITEM IDUSERS,POS ELSE REMOVE ALL IDUSERS ENABLE ITEM IDCON DISABLE ITEM IDDCON DISABLE ITEM IDMYNAME DISABLE ITEM IDDCON DISABLE ITEM IDSHUT DISABLE ITEM IDNSHUT DISABLE ITEM IDUSERS DISABLE ITEM IDUKILL DISABLE ITEM IDAKILL DISABLE ITEM IDFILE DISABLE ITEM IDBROWSE DISABLE ITEM IDCS DISABLE ITEM IDSS ENDIF EXECUTE SUBPROCEDURE CHKFILE END SUBPROCEDURE SUBPROCEDURE UINFO COMPUTE I = NUMBR(SBST(GETTXT(IDUSERS),1,4)) COMPUTE INFO = "Log: "+TIMEC(SERADMIN (4,SERADMIN (2,i,PASSWORD),PASSWORD),"hh:mm:ss")+"/"+ "Lst: "+TIMEC(SERADMIN (5,SERADMIN (2,i,PASSWORD),PASSWORD),"hh:mm:ss") IF (I gt 0) SET ITEM IDSTATUS,INFO END SUBPROCEDURE subprocedure chkfile . COMPUTE FILE = GETTXT(IDFILE) . IFTHEN (LEN(TRIM(FILE)) GT 0 AND CID GT 0) . ENABLE ITEM IDEDIT . ENABLE ITEM IDRUN . ELSE . DISABLE ITEM IDEDIT . DISABLE ITEM IDRUN . ENDIF end subprocedure END PROGRAM |} END PROCEDURE PROCEDURE {CONFERENCE 2007}.{12 REGULAR}:T (155098,54072) |Last amended Jun 06, 2007,15:01:12 program compute line='this is a test line' write line compute found=regexp(line,"^..is is",1,2) write found compute line=regrep(line,"^..is is","that was",1,2) write line end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{13 SEEK}:T (155098,54096) |Last amended Jun 06, 2007,15:01:36 program open x/dsn='test.dat'/write write(x)'1234567890' close(x) open y/dsn='test.dat'/read/binary compute dummy=seek('y',5) read(y)b(a1) write b close y end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{14 TIMESTAMP}:T (155098,53837) |Last amended Jun 06, 2007,14:57:17 program date d('dd/mm/yyyy') time t('hh:mm:ss') integer days compute d=today(0) compute t=now(0) compute ts1=dttots(d,t) write d t ts1 compute d=today(0)-1 compute t=now(0)-175 compute ts2=dttots(d,t) write d t ts2 compute ts3=ts1-ts2 compute days=tstodt(ts3) compute t=tstotm(ts3) write days 'day ' t end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{15 ENCRYPT}:T (155098,53830) |Last amended Jun 06, 2007,14:57:10 program string*80 text etext dtext string*32 key compute key = 'abcdefghijklmnopqrstuvwxyz012345' compute x = cryptkey(key) compute text = 'Testing encytption 1234 Testing' compute etext = encrypt(text,32) compute dtext = decrypt(etext,32) write [len(etext)] etext / [len(dtext)] dtext end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{16 DATES}:T (155108,61317) |Last amended Jun 16, 2007,17:01:57 program date d ('ddmmyy') date a ('dd/mm/yyyy') date t ('Wwwwwwww dd Mmmmmmmmm yyyy') Compute d='011206' write d Compute d='11206' | is no good as it does not know whether 011206 or |110206 is intended write d Compute d='01 12 06' write d Compute d='1 12 6' write d Compute a='01/12/06' write a Compute a='1 12 2006' write a Compute a='01 12 06' write a Compute a='1 12 6' write a Compute t='xx 1 12 6' | weekday can be anything as the rest |dictates what it will be so is redundant on input write t Compute t='xx 01/12/06' write t Compute t='xx 1 12 2006' write t Compute t='xx 01 12 06' write t Compute t='1 12 6' | weekday can even be missing write t End program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{17 PICTURE}:T (155098,54242) |Last amended Jun 06, 2007,15:04:02 PROGRAM c The following formats produce following output WRITE [123.4] ('$ZZ,ZZZ.99-') | $00,123.40 WRITE [123456789] ('ZZZ-ZZZ-ZZZ') | 123-456-789 WRITE [-123.4] ('99,999.99') | -123.40 WRITE [-123.4] ('$99,99Z.99') | $ -123.40 WRITE [-123.4] ('$$,$$Z.99') | -$123.40 WRITE [-123.4] ('ZZ,ZZZ.99') | -0,123.40 WRITE [-123.4] ('$ZZ,ZZZ.99') | $-0,123.40 WRITE [-123.4] ('99,999.99-') | 123.40- WRITE [-123.4] ('$99,99Z.99-') | $ 123.40- WRITE [-123.4] ('$$,$$Z.99-') | $123.40- WRITE [-123.4] ('ZZ,ZZZ.99-') | 00,123.40- WRITE [-123.4] ('$ZZ,ZZZ.99-') | $00,123.40- WRITE [1234.56]('$*******.**') | $***1234.56 WRITE [1234.56]('Z Z Z Z . Z Z') | 1 2 3 4 . 5 6 WRITE [1234.56]('ZZZZ') | 1235 END PROGRAM END PROCEDURE PROCEDURE {CONFERENCE 2007}.{18 HTML}:T (155098,54478) |Last amended Jun 06, 2007,15:07:58 program window output '

Hello World

' window output '51/4' window output '

Hello World

' html window output '51/4' html window output '' end program END PROCEDURE PROCEDURE {CONFERENCE 2007}.{19 TESTTREE}:T (155107,57252) |Last amended Jun 15, 2007,15:54:12 || Generated by DP - don't edit anything outside |{...|} |{ Header PROGRAM |} integer*2 m_id, m_arg1, m_arg2 integer*1 IDSTATIC; preset IDSTATIC (-1) integer*1 IDCLOSE ; preset IDCLOSE ( 0) integer*1 ID_ROOT ; preset ID_ROOT (1 ) |{ Prologue |} dialog "Show variables in a tree" |{ Controls postype 1 button IDCLOSE , 120, 154, 40, 0, "Close" tree ID_ROOT , 0, 111, 9, 132, 1 |} initial |{ Init compute rootnode=9999 compute subnode=rootnode+1 compute node=9999 compute num=branch(ID_ROOT,rootnode,rootnode,'') compute parentnode=rootnode ifthen(nvars(1) ne nvarsc(1)) . compute start=0 else . compute start=1 endif for i=start,nrecs(0) . compute rname=recname(i) . ifthen(exists(rname)) . compute parentnode=node . compute node=subnode+i*1000 |. write i,parentnode,node,rname . compute num=branch(ID_ROOT,parentnode,node,rname) . for j=1,nvarsc(i) . compute parentnode=subnode+i*1000 . compute varnode=subnode+i*1000+j |. write i,j ,parentnode,varnode,[varnamec(i,j)] . compute num=branch(ID_ROOT,parentnode,varnode,varnamec(i,j)) . end for . endif end for |} end initial message ALL m_id, m_arg1, m_arg2 ifthen (m_id eq ID_ROOT ) |< ID_ROOT compute pos=getpos(ID_ROOT) compute rn=aint((pos-subnode)/1000) compute str=trim(gettxt(ID_ROOT)) write str ' from ' [trim(recname(rn))] |> next message endif if (m_id eq 0) exit message end message end dialog |{ Exit |} |{ Footer END PROGRAM |} END PROCEDURE PROCEDURE {CONFERENCE 2007}.{20 SPIN}:T (155098,54790) |Last amended Jun 06, 2007,15:13:10 || Generated by DP - don't edit anything outside |{...|} |{ Header c c This program shows a slider,spin,edit and progress control. c Move the slider or press a spin arrow... c PROGRAM |} integer*2 m_id, m_arg1, m_arg2 integer*1 IDSTATIC; preset IDSTATIC (-1) integer*1 IDCLOSE ; preset IDCLOSE ( 0) integer*1 ID_00008 ; preset ID_00008 (1 ) integer*1 ID_00010 ; preset ID_00010 (2 ) integer*1 ID_00012 ; preset ID_00012 (3 ) integer*1 ID_00014 ; preset ID_00014 (4 ) integer*1 ID_00015 ; preset ID_00015 (5 ) integer*1 ID_00016 ; preset ID_00016 (6 ) integer*1 ID_00017 ; preset ID_00017 (7 ) integer*1 ID_00021 ; preset ID_00021 (8 ) |{ Prologue |} dialog "SLIDER SPIN and PROGRESS" |{ Controls postype 1 progress ID_00008 , 43, 10, 0, 84 slider ID_00010 , 54, 12, 50, 24 spin ID_00012 , 54, 12, 1, 47 label ID_00014 , 0, 0, 222, "Progress, Slider and Spin controls." label ID_00015 , 8, 0, 222, "Move the slider to change the value of the numeric text." label ID_00016 , 16, 0, 222, "Press the spin button to increment or decrement the text" label ID_00017 , 42, 125, 96, "Text range can be changed" spin ID_00021 , 53, 12, 151, 48 |} initial |{ Init COMPUTE DD = SETRANGE(ID_00021,20,28) SET ITEM ID_00021,20 |} end initial message ALL m_id, m_arg1, m_arg2 |{ Message |} ifthen (m_id eq ID_00008 ) |< ID_00008 |> next message endif ifthen (m_id eq ID_00010 ) |< ID_00010 SET ITEM ID_00012,GETPOS(ID_00010) COMPUTE DUMMY=SETPOS(ID_00008,GETPOS(ID_00010)) |> next message endif ifthen (m_id eq ID_00012 ) |< ID_00012 COMPUTE DUMMY=SETPOS(ID_00010,NUMBR(GETTXT(ID_00012))) COMPUTE DUMMY=SETPOS(ID_00008,NUMBR(GETTXT(ID_00012))) |> next message endif ifthen (m_id eq ID_00021 ) |< ID_00021 COMPUTE DUMMY=SETPOS(ID_00021,NUMBR(GETTXT(ID_00021))) |> next message endif if (m_id eq 0) exit message end message end dialog |{ Exit |} |{ Footer END PROGRAM |} END PROCEDURE PROCEDURE {CONFERENCE 2007}.{21 BUTTON}:T (155098,55340) |Last amended Jun 06, 2007,15:22:20 || Generated by DP - don't edit anything outside |{...|} |{ Header PROGRAM string *100 fn |} integer*2 m_id, m_arg1, m_arg2 integer*1 IDSTATIC; preset IDSTATIC (-1) integer*1 IDCLOSE ; preset IDCLOSE ( 0) integer*1 ID_00001 ; preset ID_00001 (1 ) |{ Prologue |} dialog "" |{ Controls postype 1 button ID_00001 , 3, 42, 40, 0, "button" button IDCLOSE , 50, 136, 40, 0, "Close" |} initial |{ Init compute fn=subdir(appdir(0),'images') compute fn=fn+'cog.bmp' set image ID_00001,fn |} end initial message ALL m_id, m_arg1, m_arg2 ifthen (m_id eq ID_00001 ) |< ID_00001 write fn |> next message endif if (m_id eq 0) exit message end message end dialog |{ Exit |} |{ Footer END PROGRAM |} END PROCEDURE PROCEDURE {CONFERENCE 2007}.{22 CLIPSET}:T (155098,55893) |Last amended Jun 06, 2007,15:31:33 || Generated by DP - don't edit anything outside |{...|} |{ Header PROGRAM |} integer*2 m_id, m_arg1, m_arg2 integer*1 IDSTATIC; preset IDSTATIC (-1) integer*1 IDCLOSE ; preset IDCLOSE ( 0) integer*1 IDTEXT ; preset IDTEXT (1 ) |{ Prologue |} dialog "" |{ Controls postype 1 text IDTEXT , 1, 80, 9, 80, 0 button IDCLOSE , 88, 27, 40, 0, "Close" |} initial |{ Attribs |} |{ Init |} end initial message ALL m_id, m_arg1, m_arg2 ifthen (m_id eq IDTEXT ) |< IDTEXT compute m=getnline(idtext) compute d=clipset(getltxt(idtext,1)) ifthen(m gt 1) for i=2,m compute d=clipapp(getltxt(idtext,i)) end for endif |> next message endif if (m_id eq 0) exit message end message end dialog |{ Exit |} |{ Footer END PROGRAM |} END PROCEDURE PROCEDURE {CONFERENCE 2007}.{23 CLIPGET}:T (155098,55881) |Last amended Jun 06, 2007,15:31:21 || Generated by DP - don't edit anything outside |{...|} |{ Header PROGRAM |} integer*2 m_id, m_arg1, m_arg2 integer*1 IDSTATIC; preset IDSTATIC (-1) integer*1 IDCLOSE ; preset IDCLOSE ( 0) integer*1 IDTEXT ; preset IDTEXT (1 ) |{ Prologue |} dialog "" |{ Controls postype 1 list IDTEXT , 1, 80, 9, 80, 1 button IDCLOSE , 88, 27, 40, 0, "Close" |} initial |{ Attribs |} |{ Init enable timer 1 |} end initial message ALL m_id, m_arg1, m_arg2 if (m_id eq 0) exit message end message message TIMER |{ Timer remove all idtext compute lines=clipline(0) ifthen(lines>0) insert item idtext 1,clipget(1) ifthen(lines>1) for i=2,lines append item idtext,clipget(i) end for end if end if |} end message end dialog |{ Exit |} |{ Footer END PROGRAM |} END PROCEDURE REMARK 'Import of members complete' TASK NAME IMPORT IMPORT 113 0/1/1/2/4/1/12/John D Jones1/1/11/772-21-1321140704/1/1/5/2150/154252/2/4/ 153515/1500/1/2/5/154128/2000/1/3/4/153575/4/1600/2/3/4/153636/5/1650/2/3/5/ 154189/4/2100/2/3/5/154246/5/2150/2/ 0/2/1/1/3/1/17/James A Arblaster1/1/11/123-72-8913138841/4/2/6/2650/154437/2/6/ 153492/2500/1/3/6/153555/3/2550/8/3/6/153597/4/2600/8/3/6/153700/5/2650/8/ 0/3/1/2/5/1/10/Mary Black2/2/11/382-97-5461142740/3/0/10/3150/154403/2/9/153395/ 2750/1/2/10/153889/3000/1/3/9/153447/3/2800/4/3/9/153541/4/2850/4/3/9/153666/5/ 2900/4/3/10/153939/4/3100/4/3/10/154032/5/3150/4/ 0/4/1/1/3/1/10/Jack Brown1/1/11/372-45-7242140758/6/1/14/3350/154554/2/14/ 152665/3200/1/3/14/152749/3/3250/8/3/14/152916/4/3300/8/3/14/153087/5/3350/8/ 0/5/1/1/2/1/12/Fred W Green1/1/11/526-91-0621141925/1/0/10/3150/154563/2/10/ 153417/3000/1/3/10/153649/3/3100/4/3/10/153826/4/3150/4/ 0/6/1/2/5/1/13/Carol F Safer2/1/11/246-87-9101144296/5/1/10/1650/154374/2/9/ 153236/2000/1/2/10/153907/2500/1/3/9/153431/2/1900/3/3/9/153637/4/2100/3/3/9/ 153834/5/2150/3/3/10/153907/4/2600/5/3/10/154003/5/1650/5/ 0/7/1/1/1/1/12/Wendy K West2/2/11/179-20-0143142778/3/2/12/2250/154556/2/12/ 154031/2200/1/3/12/154185/4/2250/8/ 0/8/1/3/9/1/14/Fredrick Moore1/1/11/236-57-3142141351/4/1/17/3600/154278/2/13/ 151284/2200/1/2/14/151987/2700/1/2/17/152386/3500/1/3/13/151436/4/2250/20/3/13/ 151630/5/2300/20/3/13/151745/5/2350/20/3/14/152085/3/2750/20/3/14/152233/4/2800/ 20/3/17/152633/4/2850/20/3/17/152808/4/2900/20/3/17/153869/5/3000/20/3/17/ 155002/5/3600/20/ 0/9/1/1/3/1/12/Bonnie Rosen2/1/11/468-32-8542138316/4/4/17/3200/154568/2/17/ 151595/3500/2/3/16/152541/5/3300/20/3/17/152153/4/3100/20/3/17/152370/4/3200/20/ 0/10/1/2/3/1/14/Leslie Kushner2/2/11/832-45-6032139213/2/1/12/2600/154322/2/11/ 152182/2200/2/2/12/152670/2500/2/3/11/152361/3/2250/11/3/11/152557/4/2300/11/3/ 12/152855/4/2600/11/ 0/11/1/1/4/1/14/Chris M Hiller1/1/11/562-83-4291138503/3/1/12/2900/154403/2/12/ 151660/2600/2/3/12/151874/3/2650/9/3/12/152110/4/2750/9/3/12/152330/4/2800/9/3/ 12/152571/4/2900/9/ 0/12/1/1/2/1/14/Michael Nugent1/2/11/834-59-4205138597/5/1/16/2450/154218/2/16/ 152928/2300/2/3/16/153265/4/2400/9/3/16/153481/4/2450/9/ 0/13/1/2/4/1/14/Cynthia Neuman2/2/11/856-48-9230140281/6/0/12/2400/154280/2/11/ 153211/2000/2/2/12/154094/2300/2/3/11/153332/3/2100/10/3/11/153634/4/2150/10/3/ 12/154189/4/2350/14/3/12/154274/5/2400/14/ 0/14/1/2/3/1/17/William F Maurice1/1/11/453-20-4234138414/1/5/16/2300/154281/2/ 15/153798/2100/2/2/16/154220/2300/2/3/15/154002/3/2150/9/3/15/154115/4/2200/9/3/ 16/154275/3/2300/9/ 0/15/1/1/2/1/13/Barry Garside1/2/11/238-64-8231141305/2/0/5/2500/154546/2/5/ 153796/2400/3/3/5/154003/3/2450/16/3/5/154175/3/2500/16/ 0/16/1/1/2/1/12/Shin-Yen Pau1/2/11/896-26-3204142218/4/0/6/2900/154416/2/6/ 153027/2700/3/3/6/153210/4/2800/19/3/6/153679/5/2900/19/ 0/17/1/2/4/1/10/Bert Stein1/1/11/924-85-3212145000/5/1/6/2800/154375/2/5/153152/ 2300/3/2/6/153690/2500/3/3/5/153323/4/2400/16/3/5/153459/5/2550/16/3/6/153796/4/ 2700/16/3/6/154004/5/2800/16/ 0/18/1/2/2/1/19/Randolph Fauntleroy1/2/11/342-93-9620143738/3/0/3/2200/154532/2/ 2/153294/1800/3/2/3/153637/2000/3/3/2/153452/5/1900/16/3/3/154161/3/2200/17/ 0/19/1/1/3/1/16/Brenda Josephine2/2/11/967-00-4932142133/4/0/17/3400/154523/2/ 17/152023/3000/3/3/17/152298/4/3200/20/3/17/152563/4/3300/20/3/17/153056/4/3400/ 20/ 0/20/0/1/0/2/18/150919/4000/2/