000098@DOCNAMES@■BIGLIST²COMBINE.LISTS²GLOBE²INVERT.LST²MENU.LST²MODIFY²MSELECT²TEXTEASY²UPPER²XLATEN■1410834TEXTEASY■* TEXTEASY - a program to make the TEXT processor more user friendly■* PROGRAM MODIFIED (8/86) BY WILLIAM R WEBBER, TO ADD MULTIPLE SCREENS■* Lines modified are indicated by '!(#)', #=number of lines modidifed■■COMMON /TEXT.MENU.COMMON/ FILENAME,DOCNAME,DOCNAMES.USED,MAXWIDTH■■SENT=TRIM(@SENTENCE)■CONVERT ' ' TO @FM IN SENT■PARM=TRIM(SENT<2>)■IF PARM='' THEN PARM='OLD'■■BOTTOM=@(0,24):@(-4)■DASHES=STR('-',29)■FSW=0■* !(4) Options - WRW 8/1/86■OPTIONS = '/C=Create /E=Edit /F=File /I=Initalize /P=Print /R=Run /S#=Screen / =TCL /[#'■MINWIDTH=13■SCREEN=0 ■MAXSCREEN=0■PERFORM 'SET-COLOR 0I,01,0H,04'■HI.LITE=@COLOR<4>■NORM=@COLOR<2>■* !■■GET.FILE.NAME:■IF FILENAME='' OR FSW THEN ■ IF FSW THEN■ OLDNAME=FILENAME■ DOCNAME=''■ END ELSE■ OLDNAME='DOCUMENTS'■ DOCNAME='LETTER'■ END■ DOCNAMES.USED=''■ MAXWIDTH=10■ PRINT BOTTOM:'Enter name of document file to use. (Default=':■ PRINT OLDNAME:')':■ PRINT HI.LITE: ; INPUT NEWFILENAME: ;PRINT NORM:■ PRINT BOTTOM:■ IF FILENAME='END' OR FILENAME='end' THEN STOP■ IF NEWFILENAME='' THEN■ FILENAME=OLDNAME■ END ELSE■ FILENAME=NEWFILENAME■ END■END■■OPEN.FILES:■OPEN '', FILENAME TO FILEIN ELSE■ PRINT BOTTOM:'Document file ':FILENAME:' does not exist. ':■ PRINT 'Create, Attach, Quit (C,A,Q)':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■■ BEGIN CASE■ CASE ANS='C'■ PERFORM 'CREATE-FILE ':FILENAME:' 1 1'■ OPEN '', FILENAME TO FILEIN ELSE■ PRINT BOTTOM:'File creation was unsuccessful. Press <ENTER>':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ GOTO GET.FILE.NAME:■ END■ CASE ANS='A'■ PRINT BOTTOM:'Enter drive to ATTACH ':FILENAME:' from':■ PRINT HI.LITE: ; INPUT DRIVE: ; PRINT NORM:■ DRIVE=TRIM(DRIVE)■ IF DIRVE='END' OR DRIVE='end' THEN STOP■ PERFORM 'ATTACH ':DRIVE:' ':FILENAME■ OPEN '', FILENAME TO FILEIN ELSE■ PRINT BOTTOM:'ATTACH was unsuccessful. Press <ENTER>':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ GOTO GET.FILE.NAME:■ END■ CASE 1■ FILENAME=''■ GOTO GET.FILE.NAME:■ END CASE■END■■READ REC FROM FILEIN, '@DOCNAMES@' THEN■ DOCNAMES.USED=REC<1>■ MAXWIDTH=REC<2>■END ELSE GOSUB INITIALIZE: ; * ! WRW 8/1/86■■■START:■PRINT @(-1):■PRINT DASHES:'Current Document Names':DASHES:■TEMP=STR('-',80)■TEMP[40-(INT(LEN(FILENAME)/2)),LEN(FILENAME)]=FILENAME■PRINT @(0,22):TEMP:OPTIONS ; * ! List of cmds - WRW 8/1/86■MAXCNT=COUNT(DOCNAMES.USED,@VM)+(DOCNAMES.USED#'')-1■ROWS=21■CNT=0■OFFSET=0■■* ! Skip document display if file contains no documents■IF MAXCNT GE 0 THEN■■* !(10) Loop keeps data on screen - WRW■REC.CNT=MAXCNT+1■MAXDISPLAY=REC.CNT■LOOP UNTIL (MAXDISPLAY-1+(21-MOD(MAXDISPLAY-1,ROWS)))*(MAXWIDTH+6) LT 1659■ IF MAXWIDTH GT MINWIDTH THEN MAXWIDTH -= 1 ELSE MAXDISPLAY -= 1■REPEAT■■NCLM=(INT(MAXDISPLAY-1)/21)+1 ; * ! Number of columns■MAXWIDTH +=INT(MOD(78,(MAXWIDTH+6))/NCLM) ; * ! Maxwidth of each column■■MAXSCREEN=INT(MAXCNT/MAXDISPLAY) ; * ! Maximum number of screens■PRINT @(0,0):'Screen ':SCREEN+1:' of ':MAXSCREEN+1:■■CNT = SCREEN*MAXDISPLAY■J=0■LOOP WHILE (J < MAXDISPLAY AND CNT < REC.CNT)■* FOR J=0 TO MAXDISPLAY-1 ! Use loop to display screeen■ CNT+=1 ■ PRINT @(OFFSET,MOD(J,ROWS)+1):CNT 'R#4':') ':HI.LITE:DOCNAMES.USED<1,CNT>[1,MAXWIDTH]:NORM : ; * changed R#3 to R#4 - WRW■ IF MOD(J+1,ROWS)=0 THEN■ OFFSET+=MAXWIDTH+6 ; * ! Changed +5 to +6 - WRW■ END■J+=1■REPEAT■END ; * ! END OF IF STATMENT FOR ZERO RECORDS IN FILE - WRW■ ■GET.ITEM.NAME:■PRINT BOTTOM:■BEGIN CASE■ CASE PARM='NEW'■ PRINT BOTTOM:'Enter name of new document to create':■ PRINT HI.LITE: ; INPUT NEWNAME: ; PRINT NORM:■ NEWNAME=TRIM(NEWNAME)■ IF NEWNAME='END' OR NEWNAME='end' THEN STOP■ IF NEWNAME[1,1]='/' THEN CMD=NEWNAME; GOSUB NEW.COMMANDS:■ IF NEWNAME='' THEN GOTO GET.ITEM.NAME:■ DOCNAME=NEWNAME■ LOCATE DOCNAME IN DOCNAMES.USED SETTING FOUND THEN■ PRINT BOTTOM:'This item already exists. Do you want to edit it (Y/N)':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ IF ANS = 'Y' THEN■ PRINT @(-1):■ PERFORM 'TEXT ':FILENAME:' ':DOCNAME■ GOSUB CHECK.FOR.DELETE:■ FLUSH■ GOTO START:■ END ELSE■ GOTO GET.ITEM.NAME:■ END■ END■ PRINT @(-1):■ PERFORM 'TEXT ':FILENAME:' ':DOCNAME■ GOSUB CHECK.FOR.NEWITEM:■ FLUSH■ GOTO START:■ CASE PARM='OLD'■ PRINT BOTTOM:'Enter name/number of document to EDIT. (Default=':■ PRINT DOCNAME:')':■ PRINT HI.LITE: ; INPUT OLDNAME: ; PRINT NORM:■ OLDNAME=TRIM(OLDNAME)■ IF OLDNAME='END' OR OLDNAME='end' THEN STOP■ IF OLDNAME[1,1]='/' THEN CMD=OLDNAME; GOSUB NEW.COMMANDS:■ IF OLDNAME='' THEN OLDNAME=DOCNAME■ OLDNAME=TRIM(OLDNAME)■ IF NUM(OLDNAME) THEN■ IF OLDNAME<1 THEN■ PRINT BOTTOM:'Document number out of range. Press <ENTER>.':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ GOTO GET.ITEM.NAME:■ END■ OLDNAME=DOCNAMES.USED<1,OLDNAME>■ IF OLDNAME='' THEN■ PRINT BOTTOM:'Document number out of range. Press <ENTER>.':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ GOTO GET.ITEM.NAME:■ END■ END■ DOCNAME=OLDNAME■ LOCATE DOCNAME IN DOCNAMES.USED SETTING FOUND THEN■ PRINT @(-1):■ PERFORM 'TEXT ':FILENAME:' ':DOCNAME■ GOSUB CHECK.FOR.DELETE:■ FLUSH■ END ELSE■ PRINT BOTTOM:'Document ':DOCNAME:' not found. Create new document (Y/N)':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ IF ANS='Y' THEN■ PRINT @(-1):■ PERFORM 'TEXT ':FILENAME:' ':DOCNAME■ GOSUB CHECK.FOR.NEWITEM:■ FLUSH■ END ELSE■ GOTO GET.ITEM.NAME:■ END■ END■ CASE PARM='PRINT'■ PRINT BOTTOM:'Enter name/number of document to PRINT. (Default=':■ PRINT DOCNAME:')':■ PRINT HI.LITE: ; INPUT OLDNAME: ; PRINT NORM:■ OLDNAME=TRIM(OLDNAME)■ IF OLDNAME='END' OR OLDNAME='end' THEN STOP■ IF OLDNAME[1,1]='/' THEN CMD=OLDNAME; GOSUB NEW.COMMANDS:■ IF OLDNAME='' THEN OLDNAME=DOCNAME■ OLDNAME=TRIM(OLDNAME)■ IF NUM(OLDNAME) THEN■ IF OLDNAME<1 THEN■ PRINT BOTTOM:'Document number out of range. Press <ENTER>.':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ GOTO GET.ITEM.NAME:■ END■ OLDNAME=DOCNAMES.USED<1,OLDNAME>■ IF OLDNAME='' THEN■ PRINT BOTTOM:'Document number out of range. Press <ENTER>.':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ GOTO GET.ITEM.NAME:■ END■ END■ DOCNAME=OLDNAME■ LOCATE DOCNAME IN DOCNAMES.USED SETTING FOUND THEN■ PRINT BOTTOM:'Printing document ':DOCNAME:'.':■ PERFORM 'COPY ':FILENAME:' ':DOCNAME:' (PS'■ PRINT BOTTOM:■ END ELSE■ PRINT BOTTOM:'Document ':DOCNAME:' not found. Press <ENTER>.':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ PRINT BOTTOM:■ END■ GOTO GET.ITEM.NAME:■ CASE 1■ PARM='OLD'■ GOTO GET.ITEM.NAME: ; * !■END CASE■GOTO START:■■CHECK.FOR.NEWITEM:■■READ TREC FROM FILEIN, DOCNAME THEN■ LOCATE DOCNAME IN DOCNAMES.USED BY 'AL' SETTING FOUND ELSE■ DOCNAMES.USED=INSERT(DOCNAMES.USED,0,FOUND,0,DOCNAME)■ END■ MLEN=LEN(DOCNAME)■■ IF MLEN>MAXWIDTH THEN MAXWIDTH=MLEN■ REC=''■ REC<1>=DOCNAMES.USED■ REC<2>=MAXWIDTH■ WRITE REC ON FILEIN, '@DOCNAMES@'■END■■RETURN■■CHECK.FOR.DELETE:■■READ TREC FROM FILEIN, DOCNAME ELSE■ LOCATE DOCNAME IN DOCNAMES.USED SETTING FOUND THEN■ * Remove deleted item from sorted list■ DOCNAMES.USED=DELETE(DOCNAMES.USED,0,FOUND,0)■ REC=''■ REC<1>=DOCNAMES.USED■ REC<2>=MAXWIDTH■ WRITE REC ON FILEIN, '@DOCNAMES@'■ END■END■■RETURN■■NEW.COMMANDS:■■NCMD=CMD[1,2]; PARAM=CMD[3,99]■BEGIN CASE■ CASE NCMD='/P' ■ PARM='PRINT'■ IF PARAM#'' THEN DATA PARAM■ CASE NCMD='/C' ■ PARM='NEW'■ IF PARAM#'' THEN DATA PARAM■ CASE NCMD='/E' ■ PARM='OLD'■ IF PARAM#'' THEN DATA PARAM■ CASE NCMD='/F' ■ FSW=1 ; SCREEN=0■ IF PARAM#'' THEN DATA PARAM■ GOTO GET.FILE.NAME:■ CASE NCMD='/R'■ READ CREC FROM FILEIN, '$':DOCNAME THEN■ PRINT @(-1):■ PERFORM 'RUN ':FILENAME:' ':DOCNAME■ PRINT BOTTOM:'Press <ENTER> to return to TEXTEASY.':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ RETURN TO START:■ END ELSE■ PRINT BOTTOM:'The compile was unsuccessful or not done yet. Press <ENTER>':■ PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ IF ANS='END' OR ANS='end' THEN STOP■ END■ CASE NCMD='/ ' OR CMD='/' ; * Process a TCL command■ SAVEPROMPT=GETPROMPT()■ PROMPT ''■ PRINT BOTTOM:'CMD->:':■ IF PARAM#'' THEN DATA PARAM■ PRINT HI.LITE: ; INPUT TCLCMD: ; PRINT NORM:■ PROMPT SAVEPROMPT■ TCLCMD=TRIM(TCLCMD)■ IF TCLCMD#'' THEN■ PERFORM TCLCMD■ RETURN TO START:■ END■* !(2) Initialize document list■ CASE NCMD='/I'■ GOSUB INITIALIZE:■* !(6) Select Screen you wish to display■ CASE NCMD='/S'■ IF NUM(PARAM) THEN■ IF PARAM GT 0 THEN SCREEN=PARAM-1 ELSE SCREEN +=1 ; IF SCREEN>MAXSCREEN THEN SCREEN=0■ IF SCREEN>MAXSCREEN THEN SCREEN=MAXSCREEN■ RETURN TO START:■ END■ * !(31) Display full name on line 24 or change minimum column width.■ CASE NCMD='/['■ CLROP=@(0,24):@(-4)■ IF PARAM='' THEN■ PRINT CLROP:'Set Minwidth, Display full name (M,D) ': ; PRINT HI.LITE: ; INPUT ANS,1: ; PRINT NORM:■ IF ANS='M' THEN■ PRINT CLROP:'Enter minimum Width 1-70 (Default=':MINWIDTH:')': ; PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ ANS=TRIM(ANS)■ IF NUM(ANS) AND ANS#'' THEN ■ MINWIDTH=ANS■ IF MINWIDTH LT 1 THEN MINWIDTH=1■ IF MINWIDTH GT 70 THEN MINWIDTH=70■ MAXWIDTH=REC<2>■ RETURN TO START:■ END■ END■ IF ANS='D' THEN■ LOOP■ PRINT CLROP:'Enter the number of the item to display ': ; PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ WHILE NUM(ANS) AND ANS#''■ IF ANS LT 1 THEN ANS=1■ IF ANS GT REC.CNT THEN ANS=REC.CNT■ PRINT CLROP:DOCNAMES.USED<1,ANS>:' ': ; PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ REPEAT■ END■ END ELSE■ IF NUM(PARAM) THEN■ DISPLAY.NAME=DOCNAMES.USED<1,PARAM>■ PRINT @(0,24):@(-4):DISPLAY.NAME:' ': ; PRINT HI.LITE: ; INPUT ANS: ; PRINT NORM:■ PRINT @(0,24):@(-4):OPTIONS:■ END■ END■* !■END CASE■■RETURN TO GET.ITEM.NAME:■■RETURN■■* ! This section is now a subroutine■INITIALIZE:■ PRINT BOTTOM:'One moment while I prepare ':FILENAME:' for use.':■ SELECT FILEIN■ READNEXT @ID ELSE GOTO START:■ LOOP■ IF @ID[1,1]#'$' AND @ID#'@DOCNAMES@' THEN■ LOCATE @ID IN DOCNAMES.USED BY 'AL' SETTING FOUND ELSE■ DOCNAMES.USED=INSERT(DOCNAMES.USED,0,FOUND,0,@ID)■ END■ MLEN=LEN(@ID)■ IF MLEN>MAXWIDTH THEN MAXWIDTH=MLEN■ END■ READNEXT @ID ELSE■ REC=''■ REC<1>=DOCNAMES.USED■ REC<2>=MAXWIDTH■ WRITE REC ON FILEIN, '@DOCNAMES@'■ GOTO START:■ END■ REPEAT■RETURN TO START:04732$TEXTEASY■' ó └üÇ└ǃΦ└$3@Ç■Φ½ΘΦ 3@ΘÇQH; ΘÇ@Ωcèg@δÇè .@∞c@φÇ@εè@∩c@≡c@└%Çh@Ç~A ±└ @≥└ @ÄÇQ∞ H∞HÑ ≤Ä@ÄÇ@J▓ ≤Çä@ÄÇÄ@ÄÇ@Äè
üUR└)ü¥RHf └)ÄüA²é ▐GN ÄÄcé c└)@é └)$@é ÄTHe Äé @└)vGÿ ∙Ç@∙ºdccÄ@∙ºeccÄ@∙⌡ü¥ô└èd@J=J u=|TEXT.MENU.COMMON OLD-L/C=Create /E=Edit /F=File /I=Initalize /P=Print /R=Run /S#=Screen / =TCL /[#SET-COLOR 0I,01,0H,04RTP18 DOCUMENTSLETTER-Enter name of document file to use. (Default=)ENDendDocument file does not exist. Create, Attach, Quit (C,A,Q)C CREATE-FILE 1 1.File creation was unsuccessful. Press <ENTER>AEnter drive to ATTACH fromATTACH 'ATTACH was unsuccessful. Press <ENTER>
@DOCNAMES@Current Document NamesScreen of R#4) NEW$Enter name of new document to create/7This item already exists. Do you want to edit it (Y/N)YTEXT 0Enter name/number of document to EDIT. (Default=,Document number out of range. Press <ENTER>. Document & not found. Create new document (Y/N)PRINT1Enter name/number of document to PRINT. (Default=Printing document .COPY (PS not found. Press <ENTER>.AL/P/C/E/F/R$RUN $Press <ENTER> to return to TEXTEASY.;The compile was unsuccessful or not done yet. Press <ENTER>/ CMD->:/I/S/[&Set Minwidth, Display full name (M,D) M"Enter minimum Width 1-70 (Default=D(Enter the number of the item to display One moment while I prepare for use.TEXTEASY
TEXT.MENU.COMMON,3,1
FILENAME,2,1
DOCNAME,2,2
DOCNAMES.USED,2,3
MAXWIDTH,2,4
SENT,-1,1
PARM,-1,2
BOTTOM,-1,3
DASHES,-1,4
FSW,-1,5
OPTIONS,-1,6
MINWIDTH,-1,7
SCREEN,-1,8
MAXSCREEN,-1,9
HI.LITE,-1,10
NORM,-1,11
OLDNAME,-1,12
NEWFILENAME,-1,13
FILEIN,-1,14
ANS,-1,15
DRIVE,-1,16
DIRVE,-1,17
REC,-1,18
TEMP,-1,19
MAXCNT,-1,20
ROWS,-1,21
CNT,-1,22
OFFSET,-1,23
REC.CNT,-1,24
MAXDISPLAY,-1,25
NCLM,-1,26
J,-1,27
NEWNAME,-1,28
CMD,-1,29
FOUND,-1,30
TREC,-1,31
MLEN,-1,32
NCMD,-1,33
PARAM,-1,34
CREC,-1,35
SAVEPROMPT,-1,36
TCLCMD,-1,37
CLROP,-1,38
DISPLAY.NAME,-1,39
01859BIGLIST■DECLARE FUNCTION XLATEN■PRINT "This program creates a record called BIGLIST in the LISTS file"■PRINT "which combines the multivalue keys of the specified"■PRINT "file, records and field."■PRINT■PRINT "File >": ; INPUT FILE■CMD='SELECT ':FILE:" ?'@ID'?... (S)"■PERFORM CMD■■IF @RECCOUNT = 0 THEN STOP 'No records selected to combine'■■DICT.FLD = ''■PRINT "Field Number (or DICT name) >": ; INPUT FLD■BEGIN CASE■CASE FLD EQ 'END' OR FLD EQ 'end' ; STOP■CASE NUM(FLD) ; DICT.FLD = ''■CASE 1 ; DICT.FLD = FLD■END CASE■■BIGLIST=''■TRUE = 1 ; FALSE = 0 ; DONE.WITH.FILE = FALSE■■DONE=FALSE■UNIQUE = ''■LOOP UNTIL UNIQUE # ''■PRINT "Are all keys unique (Y/N) ":;INPUT ANS,1■CONVERT 'yn' TO 'YN' IN ANS■IF ANS = 'Y' THEN UNIQUE = TRUE■IF ANS = 'N' THEN ■ LOOP UNTIL UNIQUE # ''■ PRINT 'Do you wish to make keys unique (Y/N)':;INPUT ANS,1■ CONVERT 'yn' TO 'YN' IN ANS■ IF ANS = 'Y' THEN UNIQUE = FALSE■ IF ANS = 'N' THEN UNIQUE = TRUE■ IF UNIQUE = '' THEN PRINT 'ANSWER Y OR N'■ REPEAT■END■IF UNIQUE = '' THEN PRINT 'Answer Y if all multivalues for all records selected are unique'■REPEAT■■LOOP UNTIL DONE.WITH.FILE■READNEXT @ID THEN■ IF DICT.FLD THEN ■ VALS = XLATEN(FILE,@ID,DICT.FLD,'X',ERROR)■ IF ERROR THEN■ BEGIN CASE■ CASE ERROR=1 ; STOP 'File ':FILE:' could not be opened'■ CASE ERROR=2 ; STOP 'Dict ':FILE:' could not be opened'■ END CASE■ END■ END ELSE VALS = XLATE(FILE,@ID,FLD,'X')■ ■ BIGLIST<1,-1> = VALS■END ELSE DONE.WITH.FILE = TRUE■REPEAT■■ENDR:■■CONVERT @VM TO @FM IN BIGLIST■NBIGLIST=''■IF UNIQUE = FALSE THEN ■I=1■*■LOOP WHILE BIGLIST<I>■V1=BIGLIST<I>■*■LOCATE V1 IN NBIGLIST BY 'AL' USING @FM SETTING A ELSE■ NBIGLIST=INSERT(NBIGLIST,A,0,0,V1)■END■*■PRINT @(0,23):I:@(-4)■I += 1■REPEAT■*■BIGLIST=NBIGLIST■END■■OPEN '','LISTS' TO FILE.OUT ELSE STOP■WRITE BIGLIST TO FILE.OUT,'BIGLIST'■■END01230$BIGLIST■ █ Ç[çÇ@[çÇt[ççÇì[ΦZΘÇöΦÇ£@└%Θ@ǼA └VcQHD Ç▓[ç|ΩÇ╤@Ç╥[δZδÇ≡QδÇ⌠Q Hc |J{ δ&Hp ΩÇ╤@J{ dH{ Ωδ@J{ ∞Ç╤@φd@εc@∩ε@≡ε@±Ç╤@±Ç╤RGÇ°[≥dcYüü≥½≥üQH║ ±φ@≥üQH±Ç╤RGü [≥dcYüü≥½≥üQHΘ ±ε@≥üQH⌡ ±φ@±Ç╤QHüC[çJ─ ±Ç╤QHüQ[çJû ∩Gö└)vHìΩHs≤Φ└)Ωüæ⌠üôA╣@⌠Ho⌠dQHXüÜΦüá[ç|Jn⌠eQHnü╡Φüá[ç|JnJ~≤Φ└)δüæc»@∞ºddc≤@JÉ∩φ@J²■∞½⌡Ç╤@±εQH÷÷d@∞÷cc H≡≈∞÷cc @≈⌡ü╗■°▐G╪⌡⌡°cc≈@cè[÷[g[ç÷ºd@J░∞⌡@Ç╤ü╛∙kG|∞∙ü─ô└èd@|>This program creates a record called BIGLIST in the LISTS file3which combines the multivalue keys of the specifiedfile, records and field.File >SELECT ?'@ID'?... (S)RTP18 No records selected to combine Field Number (or DICT name) >ENDendAre all keys unique (Y/N) ynYNYN%Do you wish to make keys unique (Y/N)ANSWER Y OR N?Answer Y if all multivalues for all records selected are uniqueXXLATENFile could not be openedDict ALLISTSBIGLISTBIGLIST
FILE,-1,1
CMD,-1,2
DICT.FLD,-1,3
FLD,-1,4
BIGLIST,-1,5
TRUE,-1,6
FALSE,-1,7
DONE.WITH.FILE,-1,8
DONE,-1,9
UNIQUE,-1,10
ANS,-1,11
VALS,-1,12
ERROR,-1,13
NBIGLIST,-1,14
I,-1,15
V1,-1,16
A,-1,17
FILE.OUT,-1,18
02345XLATEN■FUNCTION XLATEN(FN,KEY,SOURCE,CODE,ERROR)■*■* Copyright 1985 by JOHN GUNTHER. Unllimited license for personal■* use is hereby granted. NOT TO BE SOLD OR USED FOR PROMOTIONAL■* PURPOSES!■*■* Usage is same as XLATE function except:■* 1) uses DICT NAME of source field instead of field number.■* 2) source field can be a symbolic field instead of a real field.■* 3) error code is passed back to calling program.■* PARAMETERS:■* 1) FN is source file where KEY must be found.■* 2) KEY is @ID of record to look up in source file.■* 3) SOURCE is dictionary name of field to use as source.■* 4) CODE is X or C as used in XLATE function.■* 5) ERROR passes an error code back to the calling program.■* A) 0 means OK.■* B) 1 means file couldn't be opened.■* C) 2 means DICT couldn't be opened.■* D) 3 means KEY didn't exist in the source file.■* If parameter SOURCE doesn't contain a valid dictionary■* name in source file, a runtime error will occur.■* After cataloging XLATEN, you must begin the calling program or■* formula code with DECLAR FUNCTION XLATEN.■ERROR = 0 ;* initialize error code.■* ;* Open source file.■OPEN '',FN TO FV ELSE ERROR=1;GOSUB FAIL:;GOTO FIN3:■T.DICT=@DICT ;* Save existing @DICT value.■* ;* Open dictionary.■OPEN 'DICT',FN TO @DICT ELSE ERROR=2;GOSUB FAIL:;GOTO FIN2:■T.ID=@ID ;* Save existing @ID value.■@ID=KEY ;* SET @ID to supplied record key.■T.RECORD=@RECORD ;* Save existing @RECORD.■* ;* Read source record.■READ @RECORD FROM FV,@ID ELSE ERROR=3;GOSUB FAIL:;GOTO FIN1:■FUNCT.VAL=CALCULATE(SOURCE) ;* Set retuned value to value of■* ;* dictionary item.■FIN1: @RECORD=T.RECORD ;* Restore @ varibles, as needed.■@ID=T.ID■FIN2: @DICT=T.DICT■FIN3: RETURN FUNCT.VAL ;* Return to calling program.■FAIL:■ * ;* Same error action as XLATE.■ IF CODE='X' THEN FUNCT.VAL='' ELSE FUNCT.VAL=KEY■ RETURN ;* Return to GOSUB■ END00312$XLATEN■
00676COMBINE.LISTS■PRINT 'THIS PROGRAM COMBINES TWO LISTS INTO ONE NEW LIST'■PRINT■PRINT 'ENTER NAMES OF LISTS YOU WISH TO COMBINE'■PRINT 'LST1:':; INPUT LST1■PRINT 'LST2:':; INPUT LST2■PRINT■PRINT 'ENTER NAME OF COMBINED LIST'■PRINT 'LST12:':; INPUT LST12■OPEN '',"LISTS" TO FILE.LISTS ELSE■ PRINT 'NO LISTS'■ STOP■END ■DATA LST1,LST2,''■PERFORM "SELECT LISTS ?'NAME'?..."■NEW.REC=''■AGAIN:■READNEXT @ID ELSE■ PRINT 'DONE WITH LISTS'■ GOTO ENDR:■END ■READ @RECORD FROM FILE.LISTS, @ID ELSE■ PRINT 'CANT FIND LIST':@ID■ GOTO AGAIN:■END ■NEW.REC = NEW.REC:@RECORD■GOTO AGAIN:■ENDR:■WRITE NEW.REC ON FILE.LISTS,LST12■END00479$COMBINE.LISTS■ º Ç Ç[ççÇ3[çÇ\[ΦZÇb[ΘZçÇh[çÇä[ΩZÇïÇîδkGB ÇÆ[ç|└+└+ΦÇ¢ΘÇ¢ÇïÇ¢@└%Ç¥@Ç╢A ∞Çï@└)vGy Ç╝[çJ£ └*δ└)öGÉ Ç╠[└)[çJh ∞∞└*@Jh ∞δΩô└èd@|1THIS PROGRAM COMBINES TWO LISTS INTO ONE NEW LIST(ENTER NAMES OF LISTS YOU WISH TO COMBINELST1:LST2:ENTER NAME OF COMBINED LISTLST12: LISTSNO LISTSSELECT LISTS ?'NAME'?...RTP18DONE WITH LISTSCANT FIND LISTCOMBINE.LISTS
LST1,-1,1
LST2,-1,2
LST12,-1,3
FILE.LISTS,-1,4
NEW.REC,-1,5
00383GLOBE■* PROGRAM GLOBAL■* Moves specifed file to GLOBAL account and deletes original file.■■FILE.NAME=''; CMD1='RENAME-FILE '; CMD2='MOVE X C TO: GLOBAL '; CMD3='DELETE-FILE X'■TOP:■PRINT 'Enter file name that you wish to make global ':;■INPUT FILE.NAME■IF FILE.NAME EQ 'END' THEN STOP■CMD=CMD1:FILE.NAME:' X'■PERFORM CMD■CMD=CMD2:FILE.NAME:' C'■PERFORM CMD■PERFORM CMD3■GOTO TOP:■END00282$GLOBE■ c ╤ ΦÇ@ΘÇ@ΩÇ@δÇ$@Ç2[ΦZΦÇ`QH0 |∞ΘΦÇd@└%∞@ÇgA ∞ΩΦÇm@└%∞@ÇgA └%δ@ÇgA J | RENAME-FILE MOVE X C TO: GLOBAL DELETE-FILE X-Enter file name that you wish to make global END XRTP18 CGLOBE
FILE.NAME,-1,1
CMD1,-1,2
CMD2,-1,3
CMD3,-1,4
CMD,-1,5
00721INVERT.LST■SUBROUTINE INVERT.EXPOSURES(LST,FILE,FIELDS,F)■*■* Author : William Webber■* Date : 15 Jan 86■*■* Subroutine to invert only records from a select list.■*■* LST is key on LISTS file for keys of records to be inverted■* FILE is the file to be inverted■* FIELDS are the fields to be inverted separated by commas■* F is either 'Y' to clear inverted field or 'N' not to clear inverted field■*■* Works with earlier version of INVERT.ALL■*■CONVERT ',' TO @FM IN FIELDS■COL=0■AGAIN:■REMOVE FIELD FROM FIELDS AT COL SETTING MARK■IF MARK LT 3 THEN■ PERFORM "GET-LIST ":LST■ IF @RECCOUNT THEN■ DATA '', FILE, FIELD, F■ PERFORM 'INVERT.ALL'■ END■END■IF MARK NE 0 THEN GOTO AGAIN■RETURN00251$INVERT.LST■ y ÿ Ç■Ω½∞c@φΩ∞ε╥εfSHk └%ÇΦ@ÇA └VHj └+└+ÇÇΘÇφÇδÇ@└%Ç@ÇA εcRHu J% t|, GET-LIST RTP18
01701MODIFY■* PROGRAM MODIFY■* BY W.R.WEBBER■* 2 APR 86 , V1.1 8/11/86■PRINT 'Program MODIFY version 1.1'■PRINT■PRINT 'This program will modify a field value for a selected group of records.'■PRINT 'The program asks for the name of the file containing the data to be modified,'■PRINT 'the name of the field containing the data, the old value'■PRINT '(a <cr> will modify all records), and the new value.'■PRINT■PRINT 'Step 1: Select a group of records to be modified then'■PRINT ' SAVE-LIST MODIFY.LIST'■PRINT■PRINT 'Step 2: Run this program.'■PRINT■■PERFORM "GET-LIST MODIFY.LIST"■RECORDS=@RECCOUNT■IF NOT(RECORDS) THEN STOP 'NO RECORDS TO MODIFY'■CNT = 0■■PRINT "FILE.NAME ":;INPUT FILE.NAME■PRINT "FIELD.NAME ":;INPUT FIELD.NAME■DICT.FILE = 'DICT ':FILE.NAME■FIELD.NO = XLATE(DICT.FILE,FIELD.NAME,2,'X')■IF NOT(FIELD.NO) THEN STOP 'FIELD ':FIELD.NAME:' IS NOT A FIXED FIELD'■■OPEN 'DICT',FILE.NAME TO @DICT ELSE STOP 'CANT OPEN DICT ':FILE.NAME■OPEN '', FILE.NAME TO FILE ELSE STOP 'CANT OPEN FILE ':FILE.NAME■■PRINT■PRINT "OLD.VALUE OF ":FIELD.NAME:; INPUT OLD.VALUE■PRINT "NEW.VALUE OF ":FIELD.NAME:; INPUT NEW.VALUE■IF NEW.VALUE='' THEN NVALUE='NULL' ELSE NVALUE=NEW.VALUE■■AGAIN:■READNEXT @ID ELSE■ PRINT■ PRINT 'DONE WITH MODIFY.LIST'■ PRINT CNT: ' records modified'■ PRINT RECORDS-CNT: ' records not modified'■ STOP■END ■READ @RECORD FROM FILE,@ID ELSE■ PRINT 'CANT FIND ': @ID■ GOTO AGAIN:■END ■* IF OLD.VALUE THEN■OVALUE=CALCULATE(FIELD.NAME)■ IF OLD.VALUE = OVALUE OR OLD.VALUE= '' THEN■ WRITEV NEW.VALUE TO FILE,@ID,FIELD.NO■ CNT += 1■ PRINT @ID "L#10":' ': OVALUE : ' changed to ': NVALUE■ END■GOTO AGAIN:01201$MODIFY■ f Ç[ççÇ [çÇd[çÇ▓[çÇδ[ççü [çüV[ççüt[çç└%üÄ@üúA Φ└V@Φ%H_ ü⌐[ç|Θc@ü╛[ΩZü╔[δZ∞ü╒Ω@φ∞δeü█c»@φ%Hù ü▌δüΣ[ç|ü·Ω└DkG½ ü Ω[ç|üΩεkG╜ üΩ[ç|çü [δ[∩Zü.[δ[≡Z≡üQHπ ±ü<@Jµ ±≡@└)vG çüA[çΘ[üW[çΦΘ[üi[ç|└*ε└)öG$ü[└)[çJΦ ≥δÑA @∩≥Q∩üQ H`≡ε└)φz└èd@Θºd@└)üèn[üÅ[≥[üæ[±[çJΦ |Program MODIFY version 1.1GThis program will modify a field value for a selected group of records.MThe program asks for the name of the file containing the data to be modified,8the name of the field containing the data, the old value4(a <cr> will modify all records), and the new value.5Step 1: Select a group of records to be modified then SAVE-LIST MODIFY.LISTStep 2: Run this program.GET-LIST MODIFY.LISTRTP18NO RECORDS TO MODIFY
FILE.NAME FIELD.NAME DICT XFIELD IS NOT A FIXED FIELDDICTCANT OPEN DICT CANT OPEN FILE OLD.VALUE OF NEW.VALUE OF NULLDONE WITH MODIFY.LIST records modified records not modified
CANT FIND L#10 changed to MODIFY
RECORDS,-1,1
CNT,-1,2
FILE.NAME,-1,3
FIELD.NAME,-1,4
DICT.FILE,-1,5
FIELD.NO,-1,6
FILE,-1,7
OLD.VALUE,-1,8
NEW.VALUE,-1,9
NVALUE,-1,10
OVALUE,-1,11
03652MSELECT■! ■* FORMAT■* MSELECT {DICT} {FILE} {WITH STATEMENTS} {BY STATEMENTS}■*■* PROGRAM TO EXPLODE MULTI-VALUES AND SELECT EXPLODED RECORDS■* By W. R. Webber, NBS Gaithersburg MD 20899■* 9/12/86■* Program requires files 'LISTS', 'HP.SUBS'■*■* Use text to create a record in the VOC file■* @ID = COND.CHK■* field 01 = RBASIC■* 02■* 03 = HP.SUBS■* 04 = COND.CHK■*■* MSELECT must be cataloged■* ■!■* GET LAST SENTENCE■CMD=TRIM(@SENTENCE)■CMD = CMD[2,LEN(CMD)] ; * GETS RID OF LETTER M■@LAST.ERROR = ''■PERFORM CMD■IF NOT(@LAST.ERROR = '402' OR @LAST.ERROR = '404') THEN STOP 'ERROR ':@LAST.ERROR : ' * CDM DID NOT WORK'■* EXECUTE 'SAVE-LIST MSELECT'■■* SET MESSAGES■MSG1 = 'How did you ever get here!'■MSG2 = 'No value for with condition'■MSG3 = 'Can not use dictionary file'■MSG4 = ' is not a field'■MSG5 = 'No condition specified for multi-valued field, MSELECT not needed'■■* DETERMINE SELECTION CONDITIONS■* INITIALIZE VALUES■■CONVERT ' ' TO @FM IN CMD■FILE=''■COND=''■COND1=''■■I=1■IF NOT(CMD<I> EQ 'SELECT' OR CMD<1> EQ 'SSELECT') THEN STOP MSG1■■I += 1■IF CMD<I> THEN■ IF NUM(CMD<I>) OR CMD<I>='ONLY' THEN I += 1■ FILE = CMD<I>■ IF FILE = 'DICT' THEN STOP MSG3■END■■* OPEN DICT AND DATA FILES■OPEN 'DICT',FILE TO @DICT ELSE STOP CANT:"DICT ":FILE■OPEN '',FILE TO FILE.IN ELSE STOP CANT:FILE■OPEN '','LISTS' TO FILE.OUT ELSE STOP CANT:'LISTS'■■COND = ''■■LOOP I += 1 WHILE CMD<I> # ''■ BEGIN CASE■ CASE CMD<I> = 'WITH' OR CMD<I> = 'WITHOUT'■ COND1 = ''■ IF CMD<I> = 'WITHOUT' THEN COND1 = 'NOT'■ I += 1■ READV SM FROM @DICT,CMD<I>,4 ELSE STOP CMD<I>: MSG4■ IF SM[1,1]='M' THEN SM='<1,WHICH.VALUE>' ELSE SM=''■ COND1 := '({':CMD<I>:'}':SM■ IF CMD<I+1> EQ ']' THEN COND1 :='[1,':LEN(CMD<I+2>) - 2:'] EQ ' ; I +=1■ LOOP I += 1 UNTIL (CMD<I>[1,1] = "'" OR CMD<I>[1,1]='"')■ IF CMD<I> = '' THEN STOP MSG2■ IF CMD<I>='BETWEEN' OR CMD<I>='FROM' THEN■ COND1 := ' GE ':CMD<I+1>:' AND {':CMD<I-1>:'} LE':SM■ I += 2■ END ELSE COND1 := ' ':CMD<I>■ REPEAT■ COND := COND1:' ':CMD<I>:')'■ LOOP I += 1 WHILE (CMD<I>[1,1] = "'" OR CMD<I>[1,1]='"')■ COND := ' OR ':COND1:' ':CMD<I>:')'■ REPEAT■ I -= 1■ CASE CMD<I> = 'AND' OR CMD<I> = 'OR'■ COND := ' ':CMD<I>:' '■ ■ END CASE■REPEAT■* PRINT FILE■PRINT COND■IF NOT(INDEX(COND,'WHICH.VALUE',1)) THEN STOP MSG5■■* GENERATE RBASIC PROGRAM COND.CHK ON FILE HP.SUBS■OPEN '','HP.SUBS' TO HPSUBS.FILE ELSE STOP CANT:'HP.SUBS'■MSELECT = 'SUBROUTINE COND.CHK(DICT,RECORD,WHICH.VALUE,ANS)':@FM■MSELECT := "@DICT=DICT ; @RECORD=RECORD":@FM■MSELECT := "IF ":COND:" THEN ANS='1' ELSE ANS='0'":@FM■MSELECT := "RETURN"■WRITE MSELECT TO HPSUBS.FILE,'COND.CHK'■EXECUTE 'BASIC HP.SUBS COND.CHK'■■*GENERATE RECORD KEYS■* PERFORM 'GET-LIST MSELECT'■■CANT = "UNABLE TO OPEN FILE "■REC.COUNT=0■LAST.RECORD=0■FIRST.PASS=1■KEYS=''■*■*■READRECORD:■LINEMARK■*■■READNEXT @ID,WHICH.VALUE ELSE LAST.RECORD=1■■IF FIRST.PASS AND LAST.RECORD THEN STOP "ZERO Records Selected"■ ■IF LAST.RECORD THEN GOTO BREAKS■■READ @RECORD FROM FILE.IN,@ID ELSE GOTO READRECORD■■FIRST.PASS=0■■* CHECK CONDITION■CALL COND.CHK(@DICT,@RECORD,WHICH.VALUE,ANS)■IF ANS THEN■ KEYS := @ID:'²':WHICH.VALUE:' '■ REC.COUNT += 1■END■■GOTO READRECORD■■BREAKS:■■KEYS = TRIM(KEYS)■CONVERT ' ' TO @FM IN KEYS■■WRITE KEYS TO FILE.OUT,'MSELECT'■■PRINT REC.COUNT : ' Records saved on LISTS file MSELECT'■■END01924$MSELECT■ ⌡O Φ└$3@ΦΦeΦ$
ü-Q H¬∩ºüO≡Ç╨Φ±cc üM@Jn±ºd@J▀Φ±cc üTQΦ±cc üXQ H▀∩ºÇ╨Φ±cc Ç╨@J▀J%∩[ç∩ü[d!%H≈φ[ç|Çüg÷kG ≥üg[ç|≈üo■@≈ºüá■@≈ºü╝∩ü└■@≈ºü█@≈÷üΓô└èd@üδ₧≥ü@°c@∙c@·d@√Ç@└)ⁿåGu∙d@·∙Hâü[ç|∙HîJ╨└*≤└)öGÜJg·c@└D└*ⁿ²üΓA²H╔√º└)ü-ⁿÇ╨@°ºd@Jg√√3@Ç╨■√½√⌠ü/ô└èd@°[ü7[ç| RTP18402404ERROR * CDM DID NOT WORKHow did you ever get here!No value for with conditionCan not use dictionary file is not a fieldANo condition specified for multi-valued field, MSELECT not needed SELECTSSELECTONLYDICTDICT LISTSWITHWITHOUTNOTM<1,WHICH.VALUE>({}][1,] EQ '"BETWEENFROM GE AND {} LE) OR ANDOR WHICH.VALUEHP.SUBS0SUBROUTINE COND.CHK(DICT,RECORD,WHICH.VALUE,ANS)@DICT=DICT ; @RECORD=RECORDIF THEN ANS='1' ELSE ANS='0'RETURNCOND.CHKBASIC HP.SUBS COND.CHKUNABLE TO OPEN FILE ZERO Records Selected²MSELECT$ Records saved on LISTS file MSELECTMSELECT
CMD,-1,1
MSG1,-1,2
MSG2,-1,3
MSG3,-1,4
MSG4,-1,5
MSG5,-1,6
FILE,-1,7
COND,-1,8
COND1,-1,9
I,-1,10
CANT,-1,11
FILE.IN,-1,12
FILE.OUT,-1,13
SM,-1,14
HPSUBS.FILE,-1,15
MSELECT,-1,16
REC.COUNT,-1,17
LAST.RECORD,-1,18
FIRST.PASS,-1,19
KEYS,-1,20
WHICH.VALUE,-1,21
ANS,-1,22
00120UPPER■FUNCTION UPPER(OLD)■NEW=OLD■CONVERT 'abcdefghijklmnopqrstuvwxyz' TO 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' IN NEW■RETURN NEW00116$UPPER■ R ΘΦ@ÇÇ Θ½Θ)╕|abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZUPPER
OLD,-1,1
NEW,-1,2
03688MENU.LST■* ROUTINE TO LIST RDES MENUS.■! ■* SORT RDES MENUS BREAK-ON MENU.TITLE "'PB'" MENU.PROCESS MENU.COMMAND HEADING "'B' 'D' PAGE 'P' " ID-SUPP DBL-SPC (SX) BY @ID■! ■PERFORM 'SSELECT RDES MENUS (S)'■■■* ■* HEADING/FOOTING■HEADING " ** MENU SCREEN DUMP ** 'L' 'BL' 'D'"■FOOTING ""■* ■@REC.COUNT=0■LAST.BREAK=1■FIRST.PASS=1■LAST.RECORD=0■* ■* OPEN DICT AND DATA FILES■* ■OPEN "DICT","RDES" TO @DICT ELSE STOP■OPEN "","RDES" TO FILE.IN ELSE STOP■* ■* MAKE COLUMN HEADING■* ■COLHEADING " MENU.PROCESS" : @FM : "MENU.COMMAND" : @FM : "MENU.HELP"■COLLENGTH 27 : @FM : 25 : @FM : 25■* ■* NULL PREVIOUS BREAK BUCKETS■* ■PREV.MENU.TITLE=''■MENU.TITLE.BREAK.COUNT=0■* ■! ■READRECORD:■! ■* ■* ■* ZERO BREAK FLAGS TO FALSE■* ■MENU.TITLE.BREAK=0■* ■* ■READNEXT @ID,WHICH.VALUE ELSE■LAST.RECORD=1■MENU.TITLE.BREAK=1■MENU.TITLE=PREV.MENU.TITLE■END■* ■S.ATID=@ID■* ■IF FIRST.PASS AND LAST.RECORD THEN■PRINT "ZERO Records Listed"■PRINTER OFF■STOP■END■* ■IF LAST.RECORD THEN GOTO BREAKS■* ■READ @RECORD FROM FILE.IN,@ID ELSE GOTO READRECORD■* ■@REC.COUNT+=1■* ■* ■* CALCULATE VALUE(S) FOR COLUMN(S)■* ■S.ATID={@ID}■M.MENU.TITLE={MENU.TITLE} "T#20" ; P.MENU.TITLE=1 ; C.MENU.TITLE=7■* ■* INITIALIZE TEXT BREAK CHECK VARIABLE(S)■* ■S.MENU.TITLE = M.MENU.TITLE■M.MENU.PROCESS={MENU.PROCESS}<1,WHICH.VALUE> "T#25" ; P.MENU.PROCESS=1 ; C.MENU.PROCESS=7■* ■* INITIALIZE MULTIVALUE BREAK CHECK VARIABLE■* ■S.MENU.PROCESS = M.MENU.PROCESS■M.MENU.COMMAND={MENU.COMMAND}<1,WHICH.VALUE> "T#25" ; P.MENU.COMMAND=1 ; C.MENU.COMMAND=7■* ■* INITIALIZE MULTIVALUE BREAK CHECK VARIABLE■* ■S.MENU.COMMAND = M.MENU.COMMAND■M.MENU.HELP = {MENU.HELP}<1,WHICH.VALUE> "T#25" ; P.MENU.HELP=1 ; C.MENU.HELP=7■S.MENU.HELP = M.MENU.HELP■■■* ■PREVIOUS.MARK.LEVEL=0■* ■* TEST FOR CONTROL BREAK(S)■* ■IF (S.MENU.TITLE NE PREV.MENU.TITLE) OR MENU.TITLE.BREAK THEN■MENU.TITLE=PREV.MENU.TITLE■PREV.MENU.TITLE=S.MENU.TITLE■MENU.TITLE.BREAK+=1■END■* ■* ■IF FIRST.PASS THEN■FIRST.PASS=0■GOTO DETAIL■END■* ■* ■! ■BREAKS:■! ■* ■* PRINT BREAK TOTAL(S) AND ACCUMULATE TOTAL(S)■* ■@BREAK=PREV.MENU.TITLE■CONVERT CHAR(251) TO ' ' IN @BREAK■@BREAK=TRIM(@BREAK)■* ■IF MENU.TITLE.BREAK THEN■PRINT■PRINT (" ***" : "")"L#27" : " " :■PRINT SPACE(25) : " " :■PRINT SPACE(25)■IF NOT(LAST.RECORD) THEN■* ■IF MENU.TITLE.BREAK LT 3 THEN■PAGE■END■* ■END■* ■MENU.TITLE.BREAK.COUNT=0■END■* ■* PERFORM LAST RECORD OUTPUT IF DONE■* ■IF LAST.RECORD THEN■* PRINT■* PRINT @REC.COUNT : " Records Processed"■STOP■END■* ■! ■DETAIL:■! ■* ■* REMOVE APPROPRIATE VALUE FROM MULTI-VALUED COLUMN(S)■* ■NEW.MARK.LEVEL=0■* ■IF C.MENU.HELP GE PREVIOUS.MARK.LEVEL THEN■REMOVE S.MENU.HELP FROM M.MENU.HELP AT P.MENU.HELP SETTING C.MENU.HELP■END■IF C.MENU.HELP GT NEW.MARK.LEVEL THEN NEW.MARK.LEVEL=C.MENU.HELP■IF C.MENU.PROCESS GE PREVIOUS.MARK.LEVEL THEN■REMOVE S.MENU.PROCESS FROM M.MENU.PROCESS AT P.MENU.PROCESS SETTING C.MENU.PROCESS■END■IF C.MENU.PROCESS GT NEW.MARK.LEVEL THEN NEW.MARK.LEVEL=C.MENU.PROCESS■IF C.MENU.COMMAND GE PREVIOUS.MARK.LEVEL THEN■REMOVE S.MENU.COMMAND FROM M.MENU.COMMAND AT P.MENU.COMMAND SETTING C.MENU.COMMAND■END■IF C.MENU.COMMAND GT NEW.MARK.LEVEL THEN NEW.MARK.LEVEL=C.MENU.COMMAND■* ■* DO CONVERSIONS IF ANY■* ■* ■@BREAK=PREV.MENU.TITLE■CONVERT CHAR(251) TO " " IN @BREAK■@BREAK = TRIM(@BREAK)■* ■* PRINT DETAIL LINE■* ■PRINT " " : S.MENU.PROCESS "L#25" : " " :■PRINT S.MENU.COMMAND "L#25" : " " :■PRINT S.MENU.HELP "L#25"■IF NEW.MARK.LEVEL < 5 THEN PRINT■* ■IF NEW.MARK.LEVEL THEN■S.MENU.HELP=''■S.MENU.PROCESS=''■S.MENU.COMMAND=''■PREVIOUS.MARK.LEVEL=NEW.MARK.LEVEL■GOTO DETAIL■END■* ■PRINT■MENU.TITLE.BREAK.COUNT+=1■* ■GOTO READRECORD■* ■END■
