!Created by Version 11.07 From DBL FFUTIL !
DEFINE CS CMDS					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
!	CS CMDS:  contains good stuff for command-writers

!*****************************************************************************!
	SEGMENT INIT	! begins an equated command:  parses @COMMAND_TEXT,
			! saves system globals in fields in GS CMDS according
			! to the single required argument string:
			! 	C	@command
			!	S(nl)	@string(nl)	\	nl is a comma-
			!	N(nl)	@number(nl)	 \	delimited list
			!	V(nl)	@vdate(nl)	 /	of numbers 1-25.
			!	I(nl)	@integer(nl)	/	Parens required.
!*****************************************************************************!

use GS CMDS			! The GS for all the saved globals, etc.

enable to %Enabled		! Save ENABLE/DISABLE options (restored in FINI)
set @command_text to %Cmdtext	! A PM or another CM would push @COMMAND_TEXT!
set "$arg_0" to %Saved		! Command string as above

use CM CMD_INIT in DBL $@cm_dbl	! Saves globals as above from %Saved

!*****************************************************************************!
	SEGMENT FINI	! ends an equated command by restoring what INIT saved
!*****************************************************************************!

use CM CMD_FINI in DBL $@cm_dbl	! Restore globals INIT saved (in %Saved)
enable from %Enabled		! Restore ENABLE/DISABLE options
use no GS CMDS			! Release memory
exit CM				! Leave the CM
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE SD FORM					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
!FORM SD - SD for form description files for ACCFRM DataPaint
!Revised Oct 14, 1984 JSG
FORM IS ASCII
RECORD ID IS RECORD.TYPE
!
! THE HEADER RECORD
STRUCTURE FOR HEADER RECORD ID = "HEADER"
RECORD.TYPE,C,10
HEADER.RECORD,C,48
$1	HEADER.VERSION,C,5
$6	HEADER.FORM.NAME,C,40
$46	HEADER.PAGES,I,2
$48	HEADER.STATUS,C,1
!
! THE ATTRIBUTE RECORD
STRUCTURE FOR ATTRIBUTE RECORD ID = "ATTRIBUTE"
RECORD.TYPE
ATTRIBUTE.RECORD,C,30
$1	ATTRS,C,1,OCCURS 30
$1	ATTRIBUTE.FIELD.Autofill,C,1
$2	ATTRIBUTE.FIELD.Autotot,C,1
$3	ATTRIBUTE.FIELD.Blink,C,1
$4 	ATTRIBUTE.FIELD.Bold,C,1
$5	ATTRIBUTE.FIELD.Compute,C,1
$6	ATTRIBUTE.FIELD.Dim,C,1
$7	ATTRIBUTE.FIELD.Duplicate,C,1
$8	ATTRIBUTE.FIELD.Initial,C,1
$9	ATTRIBUTE.FIELD.Left,C,1
$10	ATTRIBUTE.FIELD.Mustfill,C,1
$11	ATTRIBUTE.FIELD.Preset,C,1
$12	ATTRIBUTE.FIELD.Prompt,C,1
$13	ATTRIBUTE.FIELD.Protect,C,1
$14	ATTRIBUTE.FIELD.Required,C,1
$15	ATTRIBUTE.FIELD.Reverse,C,1
$16	ATTRIBUTE.FIELD.Right,C,1
$17	ATTRIBUTE.FIELD.Underline,C,1
$18	ATTRIBUTE.FIELD.Uppercase,C,1
$24	ATTRIBUTE.TEXT.Blink,C,1
$25	ATTRIBUTE.TEXT.Bold,C,1
$26	ATTRIBUTE.TEXT.Reverse,C,1
$27	ATTRIBUTE.TEXT.Underline,C,1
!
!
! DATASET RECORD
STRUCTURE FOR DATASET RECORD ID = "DATASET"
RECORD.TYPE
DATASET.RECORD,C,513
$1	DATASET.TYPE,C,2
$3	DATASET.NAME,C,40
$43	DATASET.MODE,C,1
$44	DATASET.DOMAIN,C,40
$84	DATASET.KEY,C,40,OCCURS 5
$284	DATASET.LOOKUP,C,40,OCCURS 5
$484	DATASET.LOOKUP.SOURCE,C,6,OCCURS 5
!
! PAGE RECORD
STRUCTURE FOR PAGE RECORD ID = "PAGE"
RECORD.TYPE
PAGE.RECORD,C,5
$1	PAGE.SEQUENCE.NUMBER,I,2
$3	PAGE.FIELDS,I,3
!
! FIELD RECORD
STRUCTURE FOR FIELD RECORD ID = "FIELD"
RECORD.TYPE
FIELD.RECORD,C,527
$1	FIELD.SOURCE.DESIGNATOR,C,6	!<LIT>,<SYS>,<CAL>
$7	FIELD.NAME,C,40
$47	FIELD.TYPE,C,1
$48	FIELD.SIZE,I,4
$52	FIELD.OCCURS,I,5,OCCURS 3
$67	FIELD.ATTRIBUTE,C,30
$67	FIELD.ATTRS,C,1,OCCURS 30
$67	FIELD.Autofill,C,1
$68	FIELD.Autotot,C,1
$69	FIELD.Blink,C,1
$70 	FIELD.Bold,C,1
$71	FIELD.Compute,C,1
$72	FIELD.Dim,C,1
$73	FIELD.Duplicate,C,1
$74	FIELD.Initial,C,1
$75	FIELD.Left,C,1
$76	FIELD.Mustfill,C,1
$77	FIELD.Preset,C,1
$78	FIELD.Prompt,C,1
$79	FIELD.Protect,C,1
$80	FIELD.Required,C,1
$81	FIELD.Reverse,C,1
$82	FIELD.Right,C,1
$83	FIELD.Underline,C,1
$84	FIELD.Uppercase,C,1
$90	TEXT.Blink,C,1
$91	TEXT.Bold,C,1
$92	TEXT.Reverse,C,1
$93	TEXT.Underline,C,1
$97	FIELD.PRINT.PICTURE,C,25
$122	FIELD.TITLE.START.COL,I,3
$125	FIELD.TITLE.START.ROW,I,2
$127	FIELD.TITLE.TEXT,C,132
$259	FIELD.DATA.START.COL,I,3
$262	FIELD.DATA.START.ROW,I,2
$264	FIELD.PRESET.TEXT,C,132
$396	FIELD.HELP.TEXT,C,132
!
! END RECORD
STRUCTURE FOR FINI RECORD ID = "END"
RECORD.TYPE
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE SD TEXTFILE				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
Lyne,c,255
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

CREATE DS ###XFER SD IS TEXTFILE ENTRY ONLY	! **REBUILDER CODE**
DEFINE GS SCR.UTIL				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! GS MKENT.
! Screens and storage variables for MKENT utility.
!
! Storage variables.
%KFIELD,     C,  40    ! To hold field for exit of the loop.
%DSNAME,     C,  40    ! To hold ds that data will be entered in.
%FD.DS,      C,  40
%KSIZE,      C,   3
%KTYPE,      C,   1
%KSIZES,     C,   3,   OCCURS 6
%KTYPES,     C,   1,   OCCURS 6
%DOMAIN.ENT, C,  20,   OCCURS 5
%KFIELDS,    C,  20,   OCCURS 5
%CHECKF,     C,  40
%HOLD1,      C,  20
%HOLD2,      C,  20
%DSTYPE,     C,   1
!
!
!>>>>>>>>>>>>>>>>>>>>
LAYOUT SCREEN %MKENT
!>>>>>>>>>>>>>>>>>>>>
/ FILL          2,  2, 19, 78, @SCN_NORMAL
/ SELECTION     @SCN_REVERSE
/ BORDER        @SCN_NORMAL,' Fairfield University Screen Utility '
!
/ MESSAGE       6,  2, @SCN_NORMAL,'FD Data set (DS) name to convert: '
/  FIELD        6, 38, 40, @SCN_REVERSE, %FD.DS, ENTER
/  HELP         5, 15,12,50,@SCN_NORMAL
/  TEXT        ' This is the data set (DS) that will be used '
/  TEXT        ''
/  TEXT        ' to create the screen format global storage (GS) '
/  TEXT        ''
/  TEXT        ' and process module (PM).   Created by PAINT.  '
/  TEXT        ''
!
/ MESSAGE       9,  2, @SCN_NORMAL,'Data Index (DI) to relate in PM: '
/  FIELD        9, 38,  40, @SCN_REVERSE, %DSNAME, ENTER
/  HELP         5, 15,12,50,@SCN_NORMAL
/  TEXT        ' This is the data set (DS) that will be '
/  TEXT        ''
/  TEXT        ' related in the new screen program for update'
/  TEXT        ''
/  TEXT        ' ie: The created maintenance program will open'
/  TEXT        ''
/  TEXT        ' the entered data set.'
/  TEXT        ''
!
/ MESSAGE      12,  2, @SCN_NORMAL,'CONTROL field for exit from entry: '
/  FIELD       12, 38,  40, @SCN_REVERSE, %KFIELD, ENTER
/  HELP         5, 15,12,50,@SCN_NORMAL
/  TEXT        ' This is the field that will be used to exit'
/  TEXT        ''
/  TEXT        ' from data entry when in the screen format.  '
/  TEXT        ''
/  TEXT        ' ie: when this field is left blank or filled '
/  TEXT        ''
/  TEXT        ' with a zero, return will be made to BAR MENU'
/  TEXT        ''
/  TEXT        ' of your screen program.'
!
/ MESSAGE      15, 28,@SCN_BOLD,'Hit PF1 to enter data.'
/ MESSAGE      18, 64,@SCN_BOLD,'? for help.'
LAYOUT END
!
%MKENT.FILL,I,MAX
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE GS CMDS					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
%N,i,max		! Useful globals if I need them
%I,i,max
%J,i,max
%K,i,max
%Saved,c,50		! Command line for PM CMD_GLOBS
%Interrupts_CM,c,40	! @INTERRUPTS_CM
%Abort_CM,c,40		! @ABORT_CM
%Verb,c,20		! Command verb, used for name of help SI, etc.
%Cmdtext,c,150		! @COMMAND_TEXT in a modifiable place
%Command,c,150		! @COMMAND, other globals
%String,c,20,occurs 25
%Integer,i,10,occurs 25
%Vdate,f,occurs 25
%Number,n,10,2,occurs 25
%Enabled,i,max		! ENABLEd/DISABLEd options
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM SCR.UTIL				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! CM MKENT.
! Screenerized Paint conversion utility.
!
! Prompt for FD data set...for fields to create GS.
 SET 0 TO @ERROR_NUMBER
 DISABLE ERROR MESSAGES
 DISABLE WARNING MESSAGES
 DISABLE ERROR ABORT
 TYPE @CR
 TYPE @CR
 TYPE @CR,10S,'DOES YOUR DATA SET AND INDEX RESIDE IN CENTRAL:SIS (Y/N) [Y]: ',NOCR
 ACCEPT @STRING(5)
 IF @STRING(5)='Y','y',' '
    SET 'CENTRAL:SIS' TO @STRING(10)
 ELSE
   SET @DBL_NAME TO @STRING(10)
 CONTINUE
!
 USE NO GS
 USE GS SCR.UTIL
 USE PM FIRST IN DBL @CM_DBL EQUATE $@STRING(10) TO DBL
 SET @DBL_NAME TO @STRING(10)
 SET 'USE DS '+%FD.DS+' IN DBL '+@STRING(10) TO @COMMAND
 $@COMMAND
!
! Run program that converts FD to GS and creates a Program.
 REPORT VIA SCR.UTIL EQUATE $%FD.DS IN DBL $@STRING(10) TO X1
!
! Enable various system file input.
 ENABLE SF COMMAND INPUT
 ENABLE SF DATA INPUT
!
IF @ERROR_NUMBER NE 9 AND 823
 TYPE @CR,'[Now creating GS and PM...]'
CONTINUE
!
! Use the SF's created by CM to create GS and PM.
 USE SF ###SK.TMP
 USE SF ###PM.TMP
 USE SF ###CM.TMP
!
 SET @BREAK(@RTRIM(%FD.DS),'.')  TO @STRING
 IF @ERROR_NUMBER=0
  TYPE @CR,"**> TYPE 'USE CM ",@RTRIM @STRING,"S' TO ACCESS THE NEW SCREEN."
 ORIF @ERROR_NUMBER=9,823
  TYPE @CR,'**> THERE IS NO FD FILE BY THE ENTERED NAME IN THE DBL <**'
  TYPE '    CHECK ENTRY AND TRY AGAIN.'
 ELSE
  TYPE @CR,'**> THERE WERE PROBLEMS IN SAVING PM OR GS...'
  TYPE '**> GS AND PM WERE CREATED BUT WILL NEED WORK TO MAKE EXECUTABLE.'
 CONTINUE
!
 REMOVE SF ###SK.TMP
 REMOVE SF ###PM.TMP
 REMOVE SF ###CM.TMP
!
 ENABLE ERROR MESSAGES
 ENABLE WARNING MESSAGES
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM OPEN					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
SET 0 TO @ERROR_NUMBER
SET 0 TO @INTEGER
DISABLE ERROR ABORT
START
 IF:1 (@INTEGER = 0) AND (@ERROR_NUMBER=0)
  SET 'USE DS CENTRAL:' TO @COMMAND
  TYPE @CR,@CR,'Which data set (DS) ?  ',NOCR
 ORIF:1 (@INTEGER = 1) AND (@ERROR_NUMBER=0)
  SET 'USE DI SISDI:' TO @COMMAND
  TYPE @CR,@CR,'Which data index (DI) <RETURN>=',@RTRIM(@STRING),' ?  ',NOCR
 CONTINUE:1
 !
 IF:2 (@INTEGER = 0) AND (@ERROR_NUMBER=0)
  ACCEPT @STRING
  SET  1 TO @INTEGER
 ORIF:2 (@INTEGER=1) AND (@ERROR_NUMBER=0)
  ACCEPT @STRING(2)
  SET 2 TO @INTEGER
 ORIF:2 (@INTEGER=2) OR (@ERROR_NUMBER GT 0)
  SET 0 TO @INTEGER,@ERROr_NUMBER
  TYPE @CR,'There was a problem in entering OR DS,DI do not exist,'
  TYPE 'Hit <CR> and try again...'
  ACCEPT @STRING
 CONTINUE:2
 !
 IF:2 @STRING(2) > ' '
  SET @STRING(2) TO @STRING(1)
  SET ' ' TO @STRING(2)
 CONTINUE:2
 !
IF:5 (@ERROR_NUMBER = 0) AND (@INTEGER=1 OR @INTEGER=2)
 SET @COMMAND + @STRING + ' IN DBL CENTRAL:SIS' TO @COMMAND
 $@COMMAND
CONTINUE:5
!
LEAVE IF (@INTEGER=2) AND (@ERROR_NUMBER=0)
REPEAT
TYPE @CR,@CR,'DS ',@DS_NAME,' and  DI ',@DI_NAME,' are open.'
ENABLE ERROR ABORT
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM PAINT2FIX				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! CM PAINT2FIX.
! This CM runs PM PAINT2FIX which obtains the name of a PM created
! by DATAPAINT II and re-writes the PM.  The re-write strips off the
! following routines;
!	Busy.record.continue
!	Busy.record.prompt
!	Clear.msg
!	Create.main
!	Delete.main
!	Display.ctrlz;  This routine is also changed to be DISPLAY.PF1
!                       and the @SCN_END_CODE field is changed to 256
!                       to read PF1.
!	Display.error.msg
!	Display.error.unexpected
!	Display.msg
!	Main.delete
!	Main.enter
!	Main.get
!	Main.modify
!	Main.window
!	Put.main
!	Window.new
!
! The following SCREEN LAYOUTS are also taken out during the re-write.
!	
!	Menu.main
!	Menu.get
!	Menu.window
!	Menu.continue
!	Message.busy.record
!	Message.delete.record
!
! The DETAILS SECTION loop is also taken out.
!
! The items which are not re-written exist in a CS (CODE SEGMENT) in
! DBL CENTRAL:SIS.  It contains most of the variables from the DECLARE
! SECTION, all the LAYOUTS listed above, all the ROUTINES from the
! PROCESS SECTION listed above and most elements of the INITIAL and
! DETAIL SECTION.
!
! The following lines are also written into the new PM pointing to the
! common code in the CS in DBL CENTRAL:SIS;
!	DECLARE
!         INCLUDE DECLARES FROM CS PAINT2 IN DBL CENTRAL:SIS
!	PROCESS
!	  INCLUDE ROUTINES FROM CS PAINT2 IN DBL CENTRAL:SIS
!	INITIAL
!	  INCLUDE INITIAL.SECTION FROM CS PAINT2 IN DBL CENTRAL:SIS
!         This last one is actually the loop from the previous
!	  PM DETAIL SECTION.
!	  INCLUDE DETAIL.SECTION  FROM CS PAINT2 IN DBL CENTRAL:SIS
!
! Allow user to define screen.
DATAPAINT
!
! Run the utility.
!USE PM PAINT2FIX IN DBL @CM_DBL EQUATE $@DBL_NAME TO X1
!
! Use the system file created by the utility.
!IF (@MENU_CHOICE NE 3) and (@STRING NE "Q")
! USE SF NEWPM.CMD
!CONTINUE
!
! Remove the system file to keep account clean.
!REMOVE SF NEWPM.CMD
!
!TYPE @CR,'All done...'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM SUPPORT				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
USE CM MENU IN DBL CENTRAL:SUPPORT
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM MAIL					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
LINK TO SYS$SYSTEM:MAIL AND RETURN
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM CMD_FINI				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
use PM CMD_GLOBS in DBL $@cm_dbl		! Restores %Saved globals
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM CMD_INIT				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! CM CMD_INIT	begins an equated command

set @extract(%Cmdtext,@cr,1,1s+@tab)+@cr to %Cmdtext	! Strip leading space
set @break(%Cmdtext,1s+@tab) to %Verb			! Get command verb
set @span(%Cmdtext,1s+@tab) to %Cmdtext			! Strip command verb
set @extract(%Cmdtext,@cr,1,1s+@tab) to %Cmdtext	! Strip leading space
							! and final @CR
if %Cmdtext begins with "?"		! Help
	copy SI HELP_$%Verb in DBL $@cm_dbl to ###CMD.TMP
	link to dcl with "type /page "+@unique_id+"CMD.TMP"
	remove SF ###CMD.TMP
	include FINI from CS CMDS
continue

if @dbl_name=""
	use no DBL
else
	use DBL $@dbl_name
continue

enable interrupts,warning messages,error messages,error abort

use PM CMD_GLOBS in DBL $@cm_dbl	! Saves globals indicated in %Saved
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM BEGIN					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
use SF BEGIN.ACC
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM LBEGIN				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
use SF SYS$LOGIN:BEGIN.ACC
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM ABORT_PRINT				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
disable interrupts
set "" to @interrupts_cm
type @cr,@bell,"PRINT aborted.",@cr
start
	set @unique_id+"PRT.TMP" to %Cmdtext
leave if @file_exists(%Cmdtext)<>"YES"
	type "Deleting ",%Cmdtext @"",";*...",nocr
	remove SF $%Cmdtext
	type "done."
repeat
include FINI from CS CMDS
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM ABORT_INFO				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
disable interrupts
set "" to @interrupts_cm
kill
type @cr,"INFO aborted -- cleaning up...",@cr
if @file_exists(@unique_id+"INFO.DS")="YES"
	remove SF ###INFO.DS
continue
if @file_exists(@unique_id+"INFO.DI")="YES"
	remove SF ###INFO.DI
continue
if @file_exists(@unique_id+"INFO.CF")="YES"
	remove SF ###INFO.CF
continue
enable interrupts
include FINI from CS CMDS
END
!!This "end" was inserted by			! **REBUILDER CODE**
HOLD						! **REBUILDER CODE**
STOP						! **REBUILDER CODE**
TYPE "(Note: CM ABORT_INFO has not been saved in executable form because"
TYPE "it was not executable prior to using CM FLATTEN.)"
DEFINE CM ABORT_XFER				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
disable interrupts
set "" to @interrupts_cm
type @cr,@bell,"*** XFER aborted ***",@cr
disable warning messages,error messages,error abort
use no DS
use no SF
remove SF ###XFER.DS
remove SF ###XFER.CMD
include FINI from CS CMDS
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM XFER					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
include INIT from CS CMDS with "ACS(1,2,3,4,5)I(1)"

disable error abort,SF trace
enable SF command input,SF data input
set @len(@rtrim(%Cmdtext)) to @integer

start

	if:1 @integer = 0		! Original command line empty
		type @cr,"XFER> ",nocr
		accept @command
leave			if @command=""
	else:1
		set %Cmdtext to @command
	continue:1

	set 0 to %N,@token_pos		! Get XFER command, type, name
	start:1
		set 1+%N to %N
	leave:1 if %N > 3		! Rest of @COMMAND is IN DBL clause
		set @uc(@extract(@command,1s+@tab,1,1s+@tab)) to @string(%N)
		set @substr(@command,@token_pos+1) to @command
	leave:1 if @command=""
	repeat:1

	set @uc @chr @asc @ltrim @string(1) to @string(1)	! XFER command
	if:1 %N>=3
		set @string(3) to @string(5)	! Remove ALL punctuation
		start:2
			set	@break(@string(5),"!@#$%^&*()+{}:~|<>?-=[];`\,./") &
			+	@span( @string(5),"!@#$%^&*()+{}:~|<>?-=[];`\,./") &
			to @string(5)
		leave:2 if @token=@nul
		repeat:2
		set @uc(@string(2)+"_"+@string(5))+".TMP" to @string(4)	! File name
		set 1s+@ltrim(@command) to @command if @command<>""	! IN DBL clause
	else:1
		set "" to @string(1) unless @string(1) in "H?"	! Help: no item
	continue:1

	set 0 to @error_number
	type ""

	if:1 @string(1)="F"
		type "Copying text of item "+@string(2)+1s+@string(3)+@command+" to file "+@string(4)+"..."
		copy $@string(2) $@string(3) $@command to SF $@string(4)

	orif:1 @string(1)="K"
		if:2 @file_exists(@string(4))="YES"
			type "Removing item "+@string(2)+1s+@string(3)+@command+"..."
			remove $@string(2) $@string(3) $@command
		else:2
			set 1 to @error_number
			type "Use the FILE command to save its text first"
		continue:2

	orif:1 @string(1)="L"
		type "Listing item "+@string(2)+1s+@string(3)+@command+"..."
		list $@string(2) $@string(3) $@command

	orif:1 @string(1)="T"
		type "Typing file "+@string(4)+"..."
		spawn type /page $@string(4)

	orif:1 @string(1)="H","?"
		copy SI HELP_$@cm_name in DBL $@cm_dbl to SF ###XFR.TMP
		set @unique_id+"XFR.TMP" to @string(4)
		spawn type /page $@string(4)
		remove SF ###XFR.TMP

	orif:1 @string(1)="M"
		type "Making item "+@string(2)+1s+@string(3)+@command+" from text in file "+@string(4)+"..."
		if:2 @file_exists(@unique_id+"XFER.DS")="YES"
			remove SF ###XFER.DS
		continue:2
		copy SF $@string(4) to ###XFER.DS
		use DS ###XFER in DBL $@cm_dbl
		set @command to %Cmdtext
		set @uc(@string(2)+1s+@string(3)) to @command
		report via $@cm_name in DBL $@cm_dbl to ###XFER.CMD
		set %Cmdtext to @command
		use SF ###XFER.CMD
		remove SF ###XFER.CMD
		remove SF ###XFER.DS

	else:1
		set 1 to @error_number
		type "Commands:  <CR>, HELP, ?, or  {FILE/MAKE/LIST/KILL/TYPE} item"
		type @tab,"<CR> quits;  item can have an IN DBL clause"
	continue:1

	if:1 @string(1)="F"
		spawn dir $@string(4)
		type ""
	orif:1 @string(1)="M"
		catalog of $@string(2) $@string(3) $@command
	continue:1

leave if 0 < @integer
repeat

include FINI from CS CMDS
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM CLR					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
TRANSMIT ASCII FROM @ESC+'[2J'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM HOME					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
TRANSMIT ASCII FROM @ESC+'[H'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM REVBLI				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
TRANSMIT ASCII FROM @ESC+'[7m'+@ESC+'[5m'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM NORM					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
TRANSMIT ASCII FROM @ESC+'[0m'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM LINE					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
TRANSMIT ASCII FROM @ESC+'[4m'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM NOLINE				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
TRANSMIT ASCII FROM @ESC+'[0m'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE CM BLI					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
TRANSMIT ASCII FROM @ESC+'[5m'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM LINK					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
declare
st,i,4
ts,i,4

detail
@index(@COMMAND_TEXT,@chr(32),1) + 1 to st
if st=1
	link to dcl and return
else
	@index(@COMMAND_TEXT,@chr(13),st) - st to ts
	link to dcl with @substr(@COMMAND_TEXT,st,ts) and return
continue
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM KILL					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
INITIAL
SCREEN KILL_SCREEN
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM FIRST					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM FIRST.
! This PM retreives the DBL data needed to create new screen PM and GS.
!
CONTROL
 RELATE DBL FROM COMMAND AS DBL
 RELATE GS SCR.UTIL !IN DBL NIS:ECMD
!
!======================
DECLARE
 HOLDD,C,20
 II,I,3
!
!======================
PROCESS
!
!==============
 ROUTINE GET.KEY.FIELD.INFO
!==============
START
 START:1
  FILL %MKENT.FILL FOR ENTER
  GET FROM DBL DBL ENTRY DI %DSNAME HUSH
  'I' TO %DSTYPE
 LEAVE:1 IF @AUX='YES'
  GET FROM DBL DBL ENTRY DS %DSNAME HUSH
  'S' TO %DSTYPE
 LEAVE:1 IF @AUX='YES'
 REPEAT:1
 @UC(%KFIELD) TO %KFIELD
!
 GET FROM DBL DBL ENTRY SD SD.NAME HUSH
 START:5
  GET FROM DBL NEXT DBL TEXT HUSH
 LEAVE:5 IF @AUX='MISSI'
   @BREAK(@RTRIM(LINE.TEXT),',') TO %CHECKF
  IF:10 @LTRIM(@RTRIM(%CHECKF)) = @RTRIM(%KFIELD)
   @SPAN(LINE.TEXT,',') TO %HOLD1
   @UC(@EXTRACT(@LTRIM(@RTRIM(%HOLD1)),',')) TO %KTYPE
   @SPAN(%HOLD1,',') TO %HOLD2
   @EXTRACT(@LTRIM(@RTRIM(%HOLD2)),',') TO %KSIZE
   LEAVE
  CONTINUE:10
 REPEAT:5
REPEAT
!
!================
 ROUTINE GET.DOMAINS
!================
!
 IF %DSTYPE='I'
  GET FROM DBL ENTRY DI %DSNAME HUSH
!
 START:1
  GET FROM DBL NEXT TEXT HUSH
 LEAVE:1 IF @AUX = 'MISSI'
  @EXTRACT(LINE.TEXT," ")  TO %CHECKF HUSH
  IF:10 @UC %CHECKF= 'DOMAIN'
   INCR II
   @SPAN(LINE.TEXT," ")  TO %HOLD1 HUSH
   @UC(@EXTRACT(%HOLD1," "))  TO %DOMAIN.ENT(II) HUSH
   @SPAN(LINE.TEXT,' ')  TO %HOLD1 HUSH
   @SPAN(%HOLD1,' ')     TO %HOLD2 HUSH
   @UC(@SPAN(%HOLD2,' '))     TO %KFIELDS(II) HUSH
   IF:20 @INDEX(%KFIELDS(II),',') > 0
     @UC(@EXTRACT(%KFIELDS(II),',')) TO %KFIELDS(II) HUSH
   CONTINUE:20
  CONTINUE:10
 REPEAT:1
 CONTINUE
!
!===============
 ROUTINE GET.TYPES
!===============
 IF %DSTYPE='I'
  GET FROM DBL ENTRY DI %DSNAME HUSH
!
  GET FROM DBL DBL ENTRY SD SD.NAME HUSH
  START:5
   GET FROM DBL NEXT DBL TEXT HUSH
  LEAVE:5 IF @AUX='MISSI'
   @BREAK(@RTRIM(LINE.TEXT),',') TO %CHECKF
   START:8 FOR II =1 TO 5
    IF:10 @LTRIM(@RTRIM(%CHECKF)) = @RTRIM(%KFIELDS(II))
     @SPAN(LINE.TEXT,',') TO %HOLD1
     @UC(@EXTRACT(@RTRIM(%HOLD1),',')) TO %KTYPES(II)
      IF:15 @UC(%KTYPES(II))='D'
       '8' TO %KSIZES(II)
      ELSE:15
       @SPAN(%HOLD1,',') TO %HOLD2
       @EXTRACT(@RTRIM(%HOLD2),',') TO %KSIZES(II)
      CONTINUE:15
    CONTINUE:10
   REPEAT:8
  REPEAT:5
 CONTINUE
!
!======================
INITIAL
! Make PF1 the enter key.
 256 TO @SCN_END_CODE
 SCREEN KILL_SCREEN
 GENERATE %MKENT TO %MKENT.FILL
 PERFORM GET.KEY.FIELD.INFO
 PERFORM GET.DOMAINS
 PERFORM GET.TYPES
!
 SCREEN KILL_SCREEN
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM SCR.UTIL				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! This pm takes the .FD file that paint creates/uses and creates the SMG data
! section to screenerize them.  This section could be used as a GS or
! edited and put into a PM.
!
! Written by AJFischetti to eleviate screen type conversion from paint...
! Crude but Effective...  date: 11/25/87.
!
! Updated on 11/25/87 to handle ADD/CHANGE/DELETE/SHOW/DOMAIN. AJF.
!
! Fairfield University, Fairfield Conn.
!
!====================
CONTROL SECTION
 RELATE SD FORM      AS MASTER FOR GET
 RELATE SD FORM      AS X1     FOR GET
 RELATE SF ###SK.TMP AS REPORT 1
 RELATE SF ###PM.TMP AS REPORT 2
 RELATE SF ###CM.TMP AS REPORT 3
 RELATE GS SCR.UTIL  IN DBL NIS:ECMD
!
!====================
DECLARE
 II,       I,  3
 HOLDOM,   C, 40
 HOLDKEY,  C, 40
 ATYPE,    C,  1
 ANAME,    C, 30
 AUXR,     C,  1
 ANAM,     C, 40,    OCCURS 30
 TYPS,     C,  1,    OCCURS 30
 FLD,      C, 40,    OCCURS  2
 FLD.SIZE, I,  5,    OCCURS  2
 FLD.ROW,  I,  2,    OCCURS  2
 FLD.COL,  I,  3,    OCCURS  2
 OCC,      I,  5,    OCCURS  3
 FLD.OCC,  I,  5,    OCCURS 30
!
PROCESS
!===============
 ROUTINE PRINT.MASTER.GS
!===============
  IF:1 RECORD.TYPE:M = "FIELD"
   IF:5 FIELD.TITLE.TEXT:M > " "
    PRINT ON 1 "/ MESSAGE ",FIELD.TITLE.START.ROW:M,",",FIELD.TITLE.START.COL:M,",@SCN_NORMAL,'",@RTRIM(FIELD.TITLE.TEXT:M),"'"
   CONTINUE:5
   IF:10 FIELD.NAME:M > " " AND (FIELD.NAME:M NE FLD:D(1) AND FLD:D(2))
    PRINT ON 1 "/ FIELD ",FIELD.DATA.START.ROW:M,",",FIELD.DATA.START.COL:M,",",FIELD.SIZE:M,",@SCN_REVERSE,",@RTRIM(FIELD.NAME:M),NOCR
    IF:15 FIELD.SOURCE.DESIGNATOR:M='MAST'
     PRINT ON 1 ':X1:R',NOCR
    ELSE:15
     PRINT ON 1 ':X2',NOCR
    CONTINUE:15
   CONTINUE:10
   IF:15 FIELD.NAME:M=FLD:D(1)
     FIELD.DATA.START.ROW:M TO FLD.ROW:D(1)
     FIELD.DATA.START.COL:M TO FLD.COL:D(1)
     FIELD.SIZE:M  TO FLD.SIZE:D(1)
     FIELD.OCCURS:M(1) TO OCC:D(1)
   ORIF:15 FIELD.NAME:M=FLD:D(2)
     FIELD.DATA.START.ROW:M TO FLD.ROW:D(2)
     FIELD.DATA.START.COL:M TO FLD.COL:D(2)
     FIELD.SIZE:M  TO FLD.SIZE:D(2)
     FIELD.OCCURS:M(1) TO OCC:D(2)
   CONTINUE:15
   IF:20 FIELD.OCCURS:M > 0
    PRINT ON 1 "(",FIELD.OCCURS:M,")",NOCR
   ELSE:20
    PRINT ON 1 " ",NOCR
   CONTINUE:20
  CONTINUE:1
!
!===============
 ROUTINE PRINT.X1.GS
!===============
  IF:1 RECORD.TYPE:X1 = "FIELD"
   IF:5 FIELD.TITLE.TEXT:X1 > " "
     PRINT ON 1 "/ MESSAGE ",FIELD.TITLE.START.ROW:X1,",",FIELD.TITLE.START.COL:X1,",@SCN_NORMAL,'",@RTRIM(FIELD.TITLE.TEXT:X1),"'"
   CONTINUE:5
   IF:10 (FIELD.NAME:X1 > " ") AND (FIELD.NAME:X1 NE FLD:D(1) OR FLD:D(2))
    PRINT ON 1 "/ FIELD ",FIELD.DATA.START.ROW:X1,",",FIELD.DATA.START.COL:X1,",",FIELD.SIZE:X1,",@SCN_REVERSE,",@RTRIM(FIELD.NAME:X1),NOCR
    IF:15 FIELD.SOURCE.DESIGNATOR:X1='MAST'
     PRINT ON 1 ':X1',NOCR
    ELSE:15
     PRINT ON 1 ':X2',NOCR
    CONTINUE:15
  !   ORIF:10 (FIELD.NAME:X1=HOLDKEY:D)
  !   PRINT ON 1 "/ FIELD ",FIELD.DATA.START.ROW:X1,",",FIELD.DATA.START.COL:X1,",",FIELD.SIZE:X1,",@SCN_REVERSE, %",@RTRIM(HOLDKEY:D),NOCR
   CONTINUE:10
   IF:20 FIELD.OCCURS:X1 > 0
    PRINT ON 1 "(",FIELD.OCCURS:X1,")",NOCR
   ELSE:20
    PRINT ON 1 " ",NOCR
   CONTINUE:20
  CONTINUE:1
!
!====================
 ROUTINE PRINT.AUXS
!====================
  START FOR II=1 TO 2
   PRINT ON 1 "/ FIELD ",FLD.ROW:D(II),",",FLD.COL:D(II),",",FLD.SIZE:D(II),",@SCN_REVERSE,",@RTRIM(FLD:D(II)),NOCR
   PRINT ON 1 ':X2',NOCR
  IF:20 OCC:D(II) > 0
   PRINT ON 1 "(",OCC:D(II),"),SHOW"
  ELSE:20
   PRINT ON 1 " ,SHOW"
  CONTINUE:20
  REPEAT
!
!=======================
INITIAL SECTION
 0 TO @INTEGER,II:D
 ' ' TO AUXR:D
!
 TYPE @CR,'Please wait; converting FD to screen...'
!
 TURN ON 1 FILL OFF
 TURN ON 2 FILL OFF
!
 PRINT ON 1 'DEFINE GS ',@RTRIM(@BREAK(@DS_NAME,'.')),' IN DBL ',@STRING(10)
 PRINT ON 1 "I"
 PRINT ON 1 '! GS ',@RTRIM(@BREAK(@DS_NAME,'.'))
 PRINT ON 1 '!'
 PRINT ON 1 '%',@RTRIM(%KFIELD),',',%KTYPE,',',%KSIZE
!
START:50 FOR II = 1 TO 5
 IF:55 (%KFIELDS(II)> ' ') AND (%KFIELDS(II) NE %KFIELD)
   PRINT ON 1 '%',@RTRIM(%KFIELDS(II)),',',%KTYPES(II),NOCR
  IF:60 %KTYPES(II) NE 'D'
   PRINT ON 1 ',',%KSIZES(II)
  ELSE:60
   PRINT ON 1 ''
  CONTINUE:60
 CONTINUE:55
REPEAT:50
!
 PRINT ON 1 '!'
 PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>>>>>>>'
 PRINT ON 1 "LAYOUT SCREEN  %",@RTRIM(@BREAK(@DS_NAME,'.'))
 PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>>>>>>>'
 PRINT ON 1 "/ FILL 1,1,19,80,@SCN_NORMAL"
 PRINT ON 1 "/ SELECTION @SCN_REVERSE"
 PRINT ON 2 'DEFINE PM ',@RTRIM(@BREAK(@DS_NAME,'.')),'S',' IN DBL ',@STRING(10)
 PRINT ON 2 'I'
 PRINT ON 2 '! PM ',@RTRIM(@BREAK(@DS_NAME,'.')),'.  Screenerized paint entry.'
 PRINT ON 2 '! SMG routines for data entry format.'
 PRINT ON 2 '! Created by Fairfield University conversion utility on ',@FDATE,' at ',@FTIME
 PRINT ON 2 '!'
 PRINT ON 2 'CONTROL'
 PRINT ON 2 ' RELATE GS ',@RTRIM(@BREAK(@DS_NAME,'.'))
 PRINT ON 2 ' RELATE GS COMMON IN DBL CENTRAL:SIS AS X3'
!
IF:40 %DSTYPE='I'
 IF:50 @STRING(5)=' ','Y','y'
  PRINT ON 2 ' RELATE DI ',@RTRIM(%DSNAME),' IN DBL CENTRAL:SIS AS X1 FOR UPDATE ALLOWING UPDATE RECORD MESSAGE DISABLED'
 ELSE:50
  PRINT ON 2 ' RELATE DI ',@RTRIM(%DSNAME),' IN DBL ',@RTRIM(@STRING(10)),' AS X1 FOR UPDATE ALLOWING UPDATE RECORD MESSAGE DISABLED'
 CONTINUE:50
ELSE:40
 IF:50 @STRING(5)=' ','Y','y'
  PRINT ON 2 ' RELATE DS ',@RTRIM(%DSNAME),' IN DBL CENTRAL:SIS AS X1 ON ',@RTRIM(%KFIELD),' FOR UPDATE'
 ELSE:50
  PRINT ON 2 ' RELATE DS ',@RTRIM(%DSNAME),' IN DBL ',@RTRIM(@STRING(10)),' AS X1 ON ',@RTRIM(%KFIELD),' FOR UPDATE'
 CONTINUE:50
CONTINUE:40
!
! This PM allows for only one (1) aux DS.
! Read FD data set to obtain auxilliary relate for PM.
 START
  GET NEXT FROM X1 HUSH
 LEAVE IF (@AUX='MISSI') !OR (@INTEGER=2)
  IF:5 RECORD.TYPE:X1='DATASET' AND DATASET.LOOKUP.SOURCE:X1 = 'MAST'
   IF:10 DATASET.TYPE:X1='DI'
    PRINT ON 2 ' RELATE DI ',@RTRIM(DATASET.NAME:X1),NOCR
   ELSE:10
    PRINT ON 2 ' RELATE DS ',@RTRIM(DATASET.NAME:X1),' ON ',@RTRIM(DATASET.LOOKUP.SOURCE:X1),NOCR
   CONTINUE:10
   IF:10 DATASET.NAME:X1 HAS 'CENTRAL'
    PRINT ON 2 ' IN DBL CENTRAL:SIS',NOCR
   CONTINUE:10
    PRINT ON 2 ' AS X2 FOR INPUT ALLOWING UPDATE RECORD MESSAGE DISABLED'
    DATASET.DOMAIN:X1        TO HOLDOM:D
    DATASET.LOOKUP:X1        TO HOLDKEY:D
    @EXTRACT(DATASET.KEY,',') TO FLD:D(1)
    @SPAN(DATASET.KEY,',') TO FLD:D(2)
    'Y' TO AUXR:D
  ORIF:5 (RECORD.TYPE:X1='FIELD') AND (FIELD.SOURCE.DESIGNATOR:X1 NE 'MAST') AND (FIELD.NAME:X1 > ' ' )
      FIELD.TYPE:X1 TO ATYPE:D
      FIELD.NAME:X1 TO ANAME:D
      FIELD.OCCURS:X1 TO OCC:D(3)
      'Y' TO AUXR:D
  CONTINUE:5
!
  IF:5 (RECORD.TYPE:X1='FIELD') AND (FIELD.NAME:X1 > ' ' )
      INCR II
   IF:10 FIELD.OCCURS:X1(1) > 0
     FIELD.OCCURS:X1(1) TO FLD.OCC:D(II)
   CONTINUE:10
      FIELD.TYPE:X1 TO TYPS:D(II)
   IF:10 FIELD.SOURCE.DESIGNATOR:X1 = 'MAST'
     @RTRIM(FIELD.NAME:X1)+':X1' TO ANAM:D(II)
   ELSE:10
     @RTRIM(FIELD.NAME:X1)+':X2' TO ANAM:D(II)
   CONTINUE:10
!   TYPE ANAM:D(II)
  CONTINUE:5
 REPEAT
!
 PRINT ON 2 '!'
 PRINT ON 2 'PROCESS'
 PRINT ON 2 '!==============='
 PRINT ON 2 ' ROUTINE ADD.RECORD'
 PRINT ON 2 '!==============='
 PRINT ON 2 '! This routine handles the ADD command and is called from the MAIN menu '
 PRINT ON 2 '! with a /PERFORM command.  The user is placed in entry on screen and '
 PRINT ON 2 '! @SCN_END_CODE is initialized to accept PF1 key as the key to write the '
 PRINT ON 2 '! record.  PF1 code= 256.'
 PRINT ON 2 '!'
 PRINT ON 2 ' 256 TO @SCN_END_CODE'
 PRINT ON 2 " GENERATE %",@RTRIM(@BREAK(@DS_NAME,'.'))," TO %",@RTRIM(@BREAK(@DS_NAME,'.')),".FILL IF %",@RTRIM(@BREAK(@DS_NAME,'.')),".FILL=0"
 PRINT ON 2 "SCREEN PUT_CHARS %BAR.MENU,'Hit PF1 to write record.',3,2,@SCN_ERASE,@SCN_BOLD"
 PRINT ON 2 'START'
 PRINT ON 2 ' READY X1 HUSH '
 PRINT ON 2 ' FILL %',@RTRIM(@BREAK(@DS_NAME,'.')),'.FILL FOR ENTER'
!
 IF:30 %KTYPE='C'
  PRINT ON 2 'LEAVE IF ',@RTRIM(%KFIELD),':X1:R=" "'
 ELSE:30
  PRINT ON 2 'LEAVE IF ',@RTRIM(%KFIELD),':X1:R=0'
 CONTINUE:30
!
 PRINT ON 2 ' CREATE X1 HUSH'
!
 IF:30 %KTYPE='C'
  PRINT ON 2 ' " " TO %',@RTRIM(%KFIELD)
 ELSE:30
  PRINT ON 2 ' 0 TO %',@RTRIM(%KFIELD)
 CONTINUE:30
!
 PRINT ON 2 '  SCREEN DELETE_CHARS %BAR.MENU,68,3,2'
 PRINT ON 2 " IF:20 @AUX='YES'"
 PRINT ON 2 '  "RECORD WRITTEN TO DATABASE..." TO %MESSAGE'
 PRINT ON 2 " ORIF:20 @AUX='NO'"
 PRINT ON 2 '  "NO RECORD WRITTEN TO DATABASE..." TO %MESSAGE'
 PRINT ON 2 ' CONTINUE:20'
 PRINT ON 2 ' PERFORM PUT.MESSAGE'
 PRINT ON 2 ' PERFORM CLEAR.BUFFER'
 PRINT ON 2 " SCREEN PUT_CHARS %BAR.MENU,'Hit PF1 to write record.  Leave ",@RTRIM(%KFIELD)," blank to exit from form.',3,2,@SCN_ERASE,@SCN_BOLD"
 PRINT ON 2 'REPEAT'
 PRINT ON 2 ' PERFORM CLEAR.BUFFER'
 PRINT ON 2 '!'
 PRINT ON 2 '!==============='
 PRINT ON 2 ' ROUTINE CHANGE.RECORD'
 PRINT ON 2 '!==============='
 PRINT ON 2 '! This routine handles the CHANGE command and is called from the MAIN menu '
 PRINT ON 2 '! with a /PERFORM command.  ID is retreived from user and record GET is '
 PRINT ON 2 '! performed and displayed and user placed in chnage form on screen '
 PRINT ON 2 '! allowed to change any field accept WORK ORDER number.'
 PRINT ON 2 '!'
 PRINT ON 2 '  PERFORM GETID'
 PRINT ON 2 ' IF @AUX="YES"'
 PRINT ON 2 '  256 TO @SCN_END_CODE'
 PRINT ON 2 "  GENERATE %",@RTRIM(@BREAK(@DS_NAME,'.')),"2 TO %",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL IF %",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL=0"
 PRINT ON 2 "  SCREEN PUT_CHARS %BAR.MENU,'Correct record--hit Y key.  N=NEXT, P=PRIOR, L=LAST, F=FIRST',3,2,@SCN_ERASE,@SCN_BOLD"
 PRINT ON 2 '  START:5'
!
 IF:50 AUXR:D='Y'
   PRINT ON 2 '  PERFORM GET.RELATED'
 CONTINUE:50
!
 PRINT ON 2 '   FILL %',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL FOR SHOW'
 PRINT ON 2 '   @SCN_READ_KEYSTROKE (%',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL,600) TO @INTEGER'
 PRINT ON 2 '   IF:10 @INTEGER=78,110'
 PRINT ON 2 '     GET FROM X1 LOCKED NEXT  RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=80,112'
 PRINT ON 2 '     GET FROM X1 LOCKED PRIOR RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=76,108'
 PRINT ON 2 '     GET FROM X1 LOCKED LAST  RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=70,102'
 PRINT ON 2 '     GET FROM X1 LOCKED FIRST RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=89,121'
 PRINT ON 2 '     SCREEN DELETE_CHARS %BAR.MENU,68,3,2'
 PRINT ON 2 "     SCREEN PUT_CHARS %BAR.MENU,'Hit PF1 to write new record',3,2,@SCN_ERASE,@SCN_BOLD"
 PRINT ON 2 '     FILL %',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL FOR CHANGE'
 PRINT ON 2 '     PUT RECORD X1 HUSH'
 PRINT ON 2 '     SCREEN DELETE_CHARS %BAR.MENU,68,3,2'
 PRINT ON 2 '     LEAVE:5'
 PRINT ON 2 '   CONTINUE:10'
 PRINT ON 2 '  REPEAT:5'
 PRINT ON 2 "  'RECORD SUCCESSFULLY CHANGED AND WRITTEN...' TO %MESSAGE"
 PRINT ON 2 '  PERFORM PUT.MESSAGE'
 PRINT ON 2 '  PERFORM CLEAR.BUFFER'
 PRINT ON 2 ' CONTINUE'
 PRINT ON 2 '!'
 PRINT ON 2 '!==============='
 PRINT ON 2 ' ROUTINE DELETE.RECORD'
 PRINT ON 2 '!==============='
 PRINT ON 2 '! This routine handles the DELETE command and is called from the MAIN menu '
 PRINT ON 2 '! with a /PERFORM command.  ID is retreived from user and record GET is '
 PRINT ON 2 '! performed and displayed message is displayed for user to enter correct '
 PRINT ON 2 '! record if it is the one which is to be deleted.'
 PRINT ON 2 '!'
 PRINT ON 2 '  PERFORM GETID'
 PRINT ON 2 ' IF @AUX="YES"'
 PRINT ON 2 '  256 TO @SCN_END_CODE'
 PRINT ON 2 "  GENERATE %",@RTRIM(@BREAK(@DS_NAME,'.')),"2 TO %",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL IF %",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL=0"
 PRINT ON 2 "  SCREEN PUT_CHARS %BAR.MENU,'Correct record--hit Y key.  N=NEXT, P=PRIOR, L=LAST, F=FIRST',3,2,@SCN_ERASE,@SCN_BOLD"
 PRINT ON 2 '  START:5'
!
 IF:50 AUXR:D='Y'
   PRINT ON 2 '  PERFORM GET.RELATED'
 CONTINUE:50
!
 PRINT ON 2 '   FILL %',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL FOR SHOW'
 PRINT ON 2 '   @SCN_READ_KEYSTROKE (%',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL,600) TO @INTEGER'
 PRINT ON 2 '   IF:10 @INTEGER=78,110'
 PRINT ON 2 '     GET FROM X1 LOCKED NEXT  RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=80,112'
 PRINT ON 2 '     GET FROM X1 LOCKED PRIOR RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=76,108'
 PRINT ON 2 '     GET FROM X1 LOCKED LAST  RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=70,102'
 PRINT ON 2 '     GET FROM X1 LOCKED FIRST RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=89,121'
 PRINT ON 2 '     START:15'
 PRINT ON 2 '      SCREEN DELETE_CHARS %BAR.MENU,68,3,2'
 PRINT ON 2 "      SCREEN PUT_CHARS %BAR.MENU,'Delete record yes/no (Y/N).',3,2,@SCN_ERASE,@SCN_BOLD"
 PRINT ON 2 '      FILL %',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL FOR SHOW'
 PRINT ON 2 '      @SCN_READ_KEYSTROKE (%',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL,600) TO @INTEGER'
 PRINT ON 2 '     LEAVE:15 IF @INTEGER=78,110,89,121'
 PRINT ON 2 '     REPEAT:15'
 PRINT ON 2 '      IF:20 @INTEGER=89,121'
 PRINT ON 2 '       SCREEN DELETE_CHARS %BAR.MENU,68,3,2'
 PRINT ON 2 '       DELETE RECORD X1 HUSH'
 PRINT ON 2 '       "RECORD SUCCESSFULLY DELETED... " TO %MESSAGE'
 PRINT ON 2 '      ORIF:20 (@INTEGER=78,110) OR (@AUX="NO")'
 PRINT ON 2 '       SCREEN DELETE_CHARS %BAR.MENU,68,3,2'
 PRINT ON 2 '       "RECORD NOT DELETED... " TO %MESSAGE'
 PRINT ON 2 '      CONTINUE:20'
 PRINT ON 2 '     LEAVE:5'
 PRINT ON 2 '   CONTINUE:10'
 PRINT ON 2 '  REPEAT:5'
 PRINT ON 2 '  PERFORM PUT.MESSAGE'
 PRINT ON 2 '  PERFORM CLEAR.BUFFER'
 PRINT ON 2 ' CONTINUE'
 PRINT ON 2 '!'
 PRINT ON 2 '!==============='
 PRINT ON 2 ' ROUTINE SHOW.RECORD'
 PRINT ON 2 '!==============='
 PRINT ON 2 '! This routine handles the SHOW command and is called from the MAIN menu '
 PRINT ON 2 '! with a /PERFORM command.  ID is retreived from user and record GET is '
 PRINT ON 2 '! performed and displayed.'
 PRINT ON 2 '!'
 PRINT ON 2 '  PERFORM GETID'
 PRINT ON 2 ' IF @AUX="YES"'
 PRINT ON 2 "  GENERATE %",@RTRIM(@BREAK(@DS_NAME,'.')),"2 TO %",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL IF %",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL=0"
 PRINT ON 2 "  SCREEN PUT_CHARS %BAR.MENU,'Hit <CR> to exit, N=NEXT, P=PRIOR, L=LAST, F=FIRST',3,2,@SCN_ERASE,@SCN_BOLD"
 PRINT ON 2 '  START:5'
 !
 IF:50 AUXR:D='Y'
  PRINT ON 2 '   PERFORM GET.RELATED'
 CONTINUE:50
 !
 PRINT ON 2 '   FILL %',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL FOR SHOW'
 PRINT ON 2 '   @SCN_READ_KEYSTROKE (%',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL,600) TO @INTEGER'
 PRINT ON 2 '  LEAVE:5 IF @INTEGER=13'
 PRINT ON 2 '   IF:10 @INTEGER=78,110'
 PRINT ON 2 '     GET FROM X1 NEXT RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=80,112'
 PRINT ON 2 '     GET FROM X1 PRIOR RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=76,108'
 PRINT ON 2 '     GET FROM X1 LAST RECORD HUSH'
 PRINT ON 2 '   ORIF:10 @INTEGER=70,102'
 PRINT ON 2 '     GET FROM X1 FIRST RECORD HUSH'
 PRINT ON 2 '   CONTINUE:10'
 PRINT ON 2 '  REPEAT:5'
 PRINT ON 2 '  PERFORM CLEAR.BUFFER'
 PRINT ON 2 ' CONTINUE'
 PRINT ON 2 '!'
 PRINT ON 2 '!==============='
 PRINT ON 2 ' ROUTINE GETID'
 PRINT ON 2 '!=============== '
 PRINT ON 2 '! This routine sets <CR> as ending code for the form and fills the forms '
 PRINT ON 2 '! which prompts for the ID.'
 PRINT ON 2 '!'
 PRINT ON 2 ' 0 TO @INTEGER(20)'
 PRINT ON 2 ' 13 TO @SCN_END_CODE'
 PRINT ON 2 ' IF @INTEGER(2)=1'
 PRINT ON 2 '  GENERATE %GET',@RTRIM(%DOMAIN.ENT(1)),' TO %',@RTRIM(%DOMAIN.ENT(1)),'.FILL IF %',@RTRIM(%DOMAIN.ENT(1)),'.FILL=0'
 PRINT ON 2 '  FILL %',@RTRIM(%DOMAIN.ENT(1)),'.FILL FOR ENTER'
START:50 FOR II =  2 TO 5
 IF:55 %KFIELDS(II) > ' '
  PRINT ON 2 ' ORIF @INTEGER(2)=',II
  PRINT ON 2 '  GENERATE %GET',@RTRIM(%DOMAIN.ENT(II)),' TO %',@RTRIM(%DOMAIN.ENT(II)),'.FILL IF %',@RTRIM(%DOMAIN.ENT(II)),'.FILL=0'
  PRINT ON 2 '  FILL %',@RTRIM(%DOMAIN.ENT(II)),'.FILL FOR ENTER'
 CONTINUE:55
REPEAT:50
 PRINT ON 2 ' CONTINUE'
 PRINT ON 2 ' PERFORM VAL.ID'
 PRINT ON 2 '!'
 PRINT ON 2 '!==============='
 PRINT ON 2 ' ROUTINE VAL.ID'
 PRINT ON 2 '!==============='
 PRINT ON 2 '! This routine validates an ID received from the user.  If it is not '
 PRINT ON 2 '! valid then %MESSAGE is initialized and message is displayed.'
 PRINT ON 2 '!'
 PRINT ON 2 ' IF @INTEGER(2)=',1
 PRINT ON 2 '  GET FROM X1 LOCKED DOMAIN ',@RTRIM(%DOMAIN.ENT(1)),NOCR
 IF:50 %KFIELDS(1) HAS 'NAM'
  PRINT ON 2 ' HIGH FIT BY %',@RTRIM(%KFIELDS(1)),' HUSH'
 ELSE:50
  PRINT ON 2 ' MATCH BY %',@RTRIM(%KFIELDS(1)),' HUSH'
 CONTINUE:50
 PRINT ON 2 '  IF:1 @AUX="MISSI"'
 PRINT ON 2 '    "NO SUCH ',@RTRIM(%KFIELDS(1)),' EXISTS..." TO %MESSAGE'
 PRINT ON 2 '    PERFORM PUT.MESSAGE'
 PRINT ON 2 '  CONTINUE:1'
 START:50 FOR II = 2 TO 5
  IF:55 %KFIELDS(II) > ' '
   PRINT ON 2 ' ORIF @INTEGER(2)=',II
   PRINT ON 2 '  GET FROM X1 LOCKED DOMAIN ',@RTRIM(%DOMAIN.ENT(II)),NOCR
   IF:60 %KFIELDS(II) HAS 'NAM'
    PRINT ON 2 ' HIGH FIT BY %',@RTRIM(%KFIELDS(II)),' HUSH'
   ELSE:60
    PRINT ON 2 ' MATCH BY %',@RTRIM(%KFIELDS(II)),' HUSH'
   CONTINUE:60
   PRINT ON 2 '  IF:1 @AUX="MISSI"'
   PRINT ON 2 '    "NO SUCH ',@RTRIM(%KFIELDS(II)),' EXISTS..." TO %MESSAGE'
   PRINT ON 2 '    PERFORM PUT.MESSAGE'
   PRINT ON 2 '  CONTINUE:1'
  CONTINUE:55
 REPEAT:50
 PRINT ON 2 ' CONTINUE '
 PRINT ON 2 '!'
 PRINT ON 2 '!==============='
 PRINT ON 2 ' ROUTINE PUT.MESSAGE'
 PRINT ON 2 '!==============='
 PRINT ON 2 '! This routine places the message window into place and holds it for 3 '
 PRINT ON 2 '! seconds; the timeout to hit a key for @SCN_READ_KEYSTROKE.  The message '
 PRINT ON 2 '! displayed is a variable field in DECLARE section and is intiialized from '
 PRINT ON 2 '! the proper call routine.'
 PRINT ON 2 '!'
 PRINT ON 2 '  SCREEN PUT_CHARS %MESSAGE.WINDOW,%MESSAGE,1,2,@SCN_ERASE,@SCN_NORMAL'
 PRINT ON 2 '  SCREEN PASTE_WINDOW %MESSAGE.WINDOW,23,2'
 PRINT ON 2 '  @SCN_READ_KEYSTROKE (%MESSAGE.WINDOW,3) TO @INTEGER'
 PRINT ON 2 '  SCREEN UNPASTE_WINDOW %MESSAGE.WINDOW'
 PRINT ON 2 '!'
!
IF:50 AUXR:D='Y'
 PRINT ON 2 '!'
 PRINT ON 2 '!================'
 PRINT ON 2 ' ROUTINE GET.RELATED'
 PRINT ON 2 '!================'
 PRINT ON 2 '! This routine obtains the key matching record from the X2'
 PRINT ON 2 '! AUX DATASET.'
 PRINT ON 2 ' IF @MENU_KEYWORD="ADD"'
 PRINT ON 2 '  GET FROM X2 DOMAIN ',@RTRIM(HOLDOM:D),' MATCH BY ',@RTRIM(HOLDKEY:D),':X1:R HUSH'
 PRINT ON 2 ' ELSE'
 PRINT ON 2 '  IF:1 @INTEGER(20) = 0'
 PRINT ON 2 '   1 + @INTEGER(20) TO @INTEGER(20)'
 PRINT ON 2 '   GET FROM X2 DOMAIN ',@RTRIM(HOLDOM:D),' MATCH BY %',@RTRIM(HOLDKEY:D),' HUSH'
 PRINT ON 2 '  ELSE:1'
 PRINT ON 2 '   GET FROM X2 DOMAIN ',@RTRIM(HOLDOM:D),' MATCH BY ',@RTRIM(HOLDKEY:D),':X1 HUSH'
 PRINT ON 2 '  CONTINUE:1'
 PRINT ON 2 ' CONTINUE'
 PRINT ON 2 '!'
CONTINUE:50
!
 PRINT ON 2 '!================'
 PRINT ON 2 ' ROUTINE CLEAR.BUFFER'
 PRINT ON 2 '!================'
 PRINT ON 2 '! This routine obtains a blank record so display of screen looks blank '
 PRINT ON 2 '! after working with a record.  Other alternative was SCREEN ERASE_WINDOW '
 PRINT ON 2 '! command but this wipes out reverse video field and does not look as good '
 PRINT ON 2 '! aesthetically.'
 PRINT ON 2 '!'
!
 IF:50 %KTYPE='C'
  PRINT ON 2 '  " " TO ',@RTRIM(%KFIELD),':X1,%',@RTRIM(%KFIELD)
 ELSE:50
  PRINT ON 2 '  0  TO ',@RTRIM(%KFIELD),':X1,%',@RTRIM(%KFIELD)
 CONTINUE:50
 IF:50 ATYPE:D='C'
  PRINT ON 2 '  " " TO ',@RTRIM(ANAME),':X2',NOCR  !,@RTRIM(ANAME:D),':X2:R',NOCR
 ORIF:50 (ATYPE:D NE 'C') AND (ATYPE:D > ' ')
  PRINT ON 2 '  0  TO ',@RTRIM(ANAME:D),':X2',NOCR !@RTRIM(ANAME:D),':X2:R',NOCR
 CONTINUE:50
  IF:20 OCC:D(3)>0
   PRINT ON 2 '(',OCC:D(3),')'
  ELSE:20
   PRINT ON 2 ' '
  CONTINUE:20
!
 PRINT ON 2 '  GET FROM X1 MATCH BY %',@RTRIM(%KFIELD),' HUSH'
 PRINT ON 2 '  SCREEN DELETE_CHARS %BAR.MENU,75,3,2'
!
START FOR II = 1 TO 30
 IF:10 ANAM:D(II)> ' '
   IF:15 TYPS:D(II)='C'
     IF:20 ANAM:D(II) NOT HAVE 'X2'
       PRINT ON 2 '  " " TO ',@RTRIM(ANAM:D(II)),NOCR
      IF:25 FLD.OCC:D(II)>0
        PRINT ON 2 '(',FLD.OCC:D(II),')',NOCR
      CONTINUE:25
        PRINT ON 2 ' ,',@RTRIM(ANAM:D(II)),':R',NOCR
     ELSE:20
       PRINT ON 2 '  " " TO ',@RTRIM(ANAM:D(II)),NOCR
     CONTINUE:20
     IF:20 FLD.OCC:D(II)>0
       PRINT ON 2 '(',FLD.OCC:D(II),')'
     ELSE:20
       PRINT ON 2 ' '
     CONTINUE:20
   ELSE:15
     IF:20 ANAM:D(II) NOT HAVE 'X2'
       PRINT ON 2 '  0 TO ',@RTRIM(ANAM:D(II)),NOCR
      IF:25 FLD.OCC:D(II)>0
        PRINT ON 2 '(',FLD.OCC:D(II),')',NOCR
      CONTINUE:25
        PRINT ON 2 ' ,',@RTRIM(ANAM:D(II)),':R',NOCR
     ELSE:20
       PRINT ON 2 '  0 TO ',@RTRIM(ANAM:D(II)),NOCR
     CONTINUE:20
     IF:20 FLD.OCC:D(II)>0
       PRINT ON 2 '(',FLD.OCC:D(II),')'
     ELSE:20
       PRINT ON 2 ' '
     CONTINUE:20
   CONTINUE:15
 CONTINUE:10
REPEAT
!
 PRINT ON 2 '  FILL %',@RTRIM(@BREAK(@DS_NAME,'.')),'2.FILL FOR SHOW'
 PRINT ON 2 '  FREE ALL'
 PRINT ON 2 '!'
 PRINT ON 2 '!================'
 PRINT ON 2 ' ROUTINE MENU.DOMAIN'
 PRINT ON 2 '!================'
 PRINT ON 2 ' GENERATE %DOMAIN TO %DOMAIN.ID IF %DOMAIN.ID=0'
 PRINT ON 2 ' MENU %DOMAIN.ID'
 PRINT ON 2 ' @MENU_CHOICE TO @INTEGER(2)'
 PRINT ON 2 '!'
 PRINT ON 2 '!====================='
 PRINT ON 2 'INITIAL'
 PRINT ON 2 '! Initial system fields for use in program.'
 PRINT ON 2 ' 1 TO @INTEGER(2)'
 PRINT ON 2 ' 0 TO @INTEGER(20)'
 PRINT ON 2 '!'
 PRINT ON 2 '! Clear buffer of any previous screens.'
 PRINT ON 2 ' SCREEN KILL_SCREEN'
 PRINT ON 2 '! '
 PRINT ON 2 '! Generate the message window in the integer field %MESSAGE.WINDOW'
 PRINT ON 2 ' @SCN_CREATE_WINDOW (1,78,@SCN_BORDER,@SCN_BOLD) TO %MESSAGE.WINDOW'
 PRINT ON 2 '!'
 PRINT ON 2 '! Generate the basic maintenance screen for use as well as pasting so it'
 PRINT ON 2 '! appears that screen is always present.'
 PRINT ON 2 " GENERATE %",@RTRIM(@BREAK(@DS_NAME,'.')),"2 TO %",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL IF %",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL=0"
 PRINT ON 2 '!'
 PRINT ON 2 '! Generate the MAIN menu to integer field.'
 PRINT ON 2 ' GENERATE %BARMENU TO %BAR.MENU'
 PRINT ON 2 '!'
 PRINT ON 2 '! Paste the maintenance screen on the terminal so it appears as if always there.'
 PRINT ON 2 ' SCREEN PASTE_WINDOW %',@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL,1,1"
 PRINT ON 2 '!'
 PRINT ON 2 '! Declare the MAIN menu for use.  Bar menu allowing user to scrool thru '
 PRINT ON 2 '! choices at bottom of screen.'
 PRINT ON 2 ' MENU %BAR.MENU'
 PRINT ON 2 '!'
 PRINT ON 2 '! Last thing is to remove the pasted screen form.'
 PRINT ON 2 ' SCREEN UNPASTE_WINDOW %',@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL"
 PRINT ON 2 ' 26 TO @SCN_END_CODE'
 PRINT ON 2 'END'
 PRINT ON 2 'SAVE BUT HOLD AND STOP ON ERROR'
!
DETAIL
  PERFORM PRINT.MASTER.GS
   IF:25 (FIELD.NAME:M > ' ') AND (FIELD.SOURCE.DESIGNATOR:M='MAST') AND (FIELD.NAME:M NE %KFIELD)
    PRINT ON 1 ",DEFAULT"
   ORIF:25 (FIELD.NAME:M > ' ') AND (FIELD.SOURCE.DESIGNATOR:M NE 'MAST') AND (FIELD.NAME:M NE FLD:D(1) AND FLD:D(2))
    PRINT ON 1 ",SHOW"
   CONTINUE:25
   IF:20 (FIELD.NAME:M=HOLDKEY:D) AND (AUXR:D='Y')
     PRINT ON 1 '/  PERFORM GET.RELATED'
     PERFORM PRINT.AUXS
   CONTINUE:20
!
FINAL SECTION
 PRINT ON 1 "LAYOUT END"
 PRINT ON 1 "%",@RTRIM(@BREAK(@DS_NAME,'.')),".FILL,I,MAX"
 PRINT ON 1 '!'
 PRINT ON 1 '!'
 PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>>>>>>>'
 PRINT ON 1 "LAYOUT SCREEN  %",@RTRIM(@BREAK(@DS_NAME,'.')),'2'
 PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>>>>>>>'
 PRINT ON 1 "/ FILL 1,1,19,80,@SCN_NORMAL"
 PRINT ON 1 "/ SELECTION @SCN_REVERSE"
!
 GET FIRST FROM X1 HUSH
 PERFORM PRINT.X1.GS
 START
  GET NEXT FROM X1 HUSH
 LEAVE IF @AUX='MISSI'
   PERFORM PRINT.X1.GS
  IF:25 (FIELD.NAME:X1 > ' ') AND (FIELD.NAME:X1 NE %KFIELD) AND (FIELD.SOURCE.DESIGNATOR:X1='MAST')
   PRINT ON 1 ",DEFAULT"
  ORIF:25 (FIELD.NAME:X1=%KFIELD) OR ((FIELD.NAME:X1>' ' AND FIELD.SOURCE.DESIGNATOR:X1 NE 'MAST'))
   PRINT ON 1 ",SHOW"
  CONTINUE:25
  IF:20 (FIELD.NAME:X1=HOLDKEY:D) AND (AUXR:D="Y")
   PRINT ON 1 '/  PERFORM GET.RELATED'
  CONTINUE:20
 REPEAT
!
 PRINT ON 1 "LAYOUT END"
 PRINT ON 1 "%",@RTRIM(@BREAK(@DS_NAME,'.')),"2.FILL,I,MAX"
!
 PRINT ON 1 '!'
 PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>'
 PRINT ON 1 'LAYOUT SCREEN %DOMAIN'
 PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>'
 PRINT ON 1 '/ MENU       23,  2,  1,  78, @SCN_NORMAL'
 PRINT ON 1 '/ SELECTION  2, 0,  @SCN_REVERSE'
 PRINT ON 1 "/ BORDER   @SCN_REVERSE,''"
 PRINT ON 1 '!'
 PRINT ON 1 '! YOU MUST FILL IN ADDITIONAL DOMAINS FROM YOUR DATA INDEX...'
 PRINT ON 1 "/ ITEM       1,  2,  @SCN_NORMAL,''"
 PRINT ON 1 "/  KEYWORD   1,  2,  @SCN_NORMAL,'By ",@RTRIM(%KFIELDS(1)),"'"
 PRINT ON 1 '!'
!
IF:30 %DSTYPE='I'
 IF:40 %KFIELDS(2)>' '
 PRINT ON 1 "/ ITEM       1,  18,  @SCN_NORMAL,''"
 PRINT ON 1 "/  KEYWORD   1,  18,  @SCN_NORMAL,'By ",@RTRIM(%KFIELDS(2)),"'"
 PRINT ON 1 '!'
 CONTINUE:40
!
 IF:40 %KFIELDS(3)>' '
 PRINT ON 1 "/ ITEM       1,  34,  @SCN_NORMAL,''"
 PRINT ON 1 "/  KEYWORD   1,  34,  @SCN_NORMAL,'By ",@RTRIM(%KFIELDS(3)),"'"
 PRINT ON 1 '!'
 CONTINUE:40
!
 IF:40 %KFIELDS(4)>' '
 PRINT ON 1 "/ ITEM       1,  50,  @SCN_NORMAL,''"
 PRINT ON 1 "/  KEYWORD   1,  50,  @SCN_NORMAL,'By ",@RTRIM(%KFIELDS(4)),"'"
 PRINT ON 1 '!'
 CONTINUE:40
!
 IF:40 %KFIELDS(5)>' '
 PRINT ON 1 "/ ITEM       1,  66,  @SCN_NORMAL,''"
 PRINT ON 1 "/  KEYWORD   1,  66,  @SCN_NORMAL,'By ",@RTRIM(%KFIELDS(5)),"'"
 PRINT ON 1 '!'
 CONTINUE:40
CONTINUE:30
 PRINT ON 1 'LAYOUT END'
 PRINT ON 1 '%DOMAIN.ID,I,MAX'
 PRINT ON 1 '!'
!
START:50 FOR II = 1 TO 5
 IF:55 %DOMAIN.ENT(II)> ' '
  100 TO @INTEGER
  PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>'
  PRINT ON 1 'LAYOUT SCREEN %GET',@RTRIM(%DOMAIN.ENT(II))
  PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>'
  PRINT ON 1 '/ FILL       23,  2,  1, 40, @SCN_NORMAL'
  PRINT ON 1 '/ SELECTION  @SCN_REVERSE   '
  PRINT ON 1 "/ BORDER     @SCN_REVERSE,''"
  PRINT ON 1 "/ MESSAGE     1,  2,  @SCN_NORMAL, 'Enter ",@RTRIM(%KFIELDS(II)),": '"
  PRINT ON 1 '/ FIELD       1, ',(@LEN(%KFIELDS(II)) + 11) ,',',%KSIZES(II),',@SCN_REVERSE, %',@RTRIM(%KFIELDS(II)),', ENTER'
   IF:60 %KFIELDS(II)=HOLDKEY:D
    PRINT ON 1 '/  PERFORM GET.RELATED'
   CONTINUE:60
  PRINT ON 1 'LAYOUT END'
  PRINT ON 1 '%',@RTRIM(%DOMAIN.ENT(II)),'.FILL,I,MAX'
  PRINT ON 1 '!'
 CONTINUE:55
REPEAT:50
!
IF:50 @INTEGER NE 100
  PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>'
  PRINT ON 1 'LAYOUT SCREEN %GET',@RTRIM(%KFIELD)
  PRINT ON 1 '!>>>>>>>>>>>>>>>>>>>>'
  PRINT ON 1 '/ FILL       23,  2,  1, 40, @SCN_NORMAL'
  PRINT ON 1 '/ SELECTION  @SCN_REVERSE   '
  PRINT ON 1 "/ BORDER     @SCN_REVERSE,''"
  PRINT ON 1 "/ MESSAGE     1,  2,  @SCN_NORMAL, 'Enter ",@RTRIM(%KFIELD),": '"
  PRINT ON 1 '/ FIELD       1, ',(@LEN(%KFIELD) + 11) ,',',%KSIZE,',@SCN_REVERSE, %',@RTRIM(%KFIELD),', ENTER'
   IF:60 %KFIELD=HOLDKEY:D
    PRINT ON 1 '/  PERFORM GET.RELATED'
   CONTINUE:60
  PRINT ON 1 'LAYOUT END'
  PRINT ON 1 '%',@RTRIM(%KFIELD),'.FILL,I,MAX'
  PRINT ON 1 '!'
CONTINUE:50
!
 PRINT ON 1 'END'
 PRINT ON 1 'SAVE BUT HOLD AND STOP ON ERROR'
 !
 PRINT ON 3
 PRINT ON 3  'DEFINE CM ',@RTRIM(@BREAK(@DS_NAME,'.')),'S',' IN DBL ',@STRING(10)
 PRINT ON 3 'I'
  @BREAK(@RTRIM(%FD.DS),'.')  TO @STRING
 PRINT ON 3 '! CM ',@RTRIM(@BREAK(@DS_NAME,'.')),'S.'
 PRINT ON 3 '!'
 PRINT ON 3 ' USE NO GS'
 PRINT ON 3 ' DISABLE ERROR   MESSAGES'
 PRINT ON 3 ' DISABLE WARNING MESSAGES'
 PRINT ON 3 '!'
 PRINT ON 3 '! Open global storage *** COMMON *** ALWAYS SECOND...'
 PRINT ON 3 ' USE GS ',@STRING
 PRINT ON 3 ' USE GS COMMON IN DBL CENTRAL:SIS'
  @BREAK(@RTRIM(%FD.DS),'.')+'S'  TO @STRING(6)
 PRINT ON 3 ' !'
 PRINT ON 3 ' ! Execute process.'
 PRINT ON 3 ' USE PM ',@STRING(6)
 PRINT ON 3 '!'
 PRINT ON 3 ' ENABLE ERROR   MESSAGES'
 PRINT ON 3 ' ENABLE WARNING MESSAGES'
 PRINT ON 3 ' END'
 PRINT ON 3 'SAVE BUT HOLD AND STOP ON ERROR'
END
!!This "end" was inserted by			! **REBUILDER CODE**
HOLD						! **REBUILDER CODE**
STOP						! **REBUILDER CODE**
TYPE "(Note: PM SCR.UTIL has not been saved in executable form because"
TYPE "it was not executable prior to using CM FLATTEN.)"
DEFINE PM EDI					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
INITIAL
'ED/EDT' TO @EDITOR
TYPE @CR,'@Editor is now initialized for EDT...'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM ENB					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
ENABLE INTERRUPTS
ENABLE INTERRUPT EXIT
ENABLE RECORD COUNTS
ENABLE WARNING MESSAGES
ENABLE ERROR MESSAGES
ENABLE ERROR ABORT
ENABLE COMMAND AREA TRACE
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM DSB					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
DISABLE INTERRUPTS
DISABLE INTERRUPT EXIT
DISABLE RECORD COUNTS
DISABLE WARNING MESSAGES
DISABLE ERROR MESSAGES
DISABLE ERROR ABORT
DISABLE COMMAND AREA TRACE
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM BELL					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
TYPE @RPT(@BELL,5)
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM PAINT2FIX				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM PAINT2FIX.
! This PM strips off the uneeded code from the PM's that PAINT II creates.
! It inserts a pointer to the common routines located in the CS PAINT in
! DBL CENTRAL:SIS.
!
!===============
control
relate dbl from command                      as x1
relate di  sisdi:paint2 in dbl central:sis as x2
relate sf  newpm.cmd                         as report 1
!
!===============
declare
lines,    c, 500
endr,     i, 1
flag,     i, 1
col,      i, 2
lncnt,    i, 2
pmname,   c, 25
main.id,  i, max
getpm.id, i, max
!
layout screen main
 / menu        4, 15, 18, 50, @scn_normal
 / selection   1,  5, @scn_reverse
 / border      @scn_bold,' DATAPAINT II Code Segment Utility '
 / message   4,  4, @scn_normal, "Do you want to see the PM names ? "
 / item      4, 40, @scn_bold, ''
 / keyword   4 ,40, @scn_bold, 'Yes'
 / perform get.pms
 / item      5, 40, @scn_bold, ''
 / keyword   5, 40, @scn_bold, 'No'
 / item      6, 40, @scn_bold, ''
 / keyword   6, 40, @scn_bold, 'Quit'
layout end
!
layout screen getpm
 / fill        15, 8, 5, 65, @scn_normal
 / selection   @scn_reverse
 / border      @scn_reverse,''
 / message   2, 7, @scn_normal,"Enter the PM to convert:"
 / field     2,33, 25,@scn_reverse,pmname:d,enter
layout end
!
!===============
process
!
!--------------
Routine get.pm.name
 13 to @scn_end_code
 screen paste_window getpm.id:d,15,8
 start
  screen put_chars getpm.id:d, "Hit <RETURN> to enter name; Q to QUIT.",4,13,@scn_noerase,@scn_bold
  fill getpm.id for enter
 !
 ! Get the PM from the DBL.
  @uc(pmname:d) to pmname:d
  get from X1 dbl entry PM pmname:d hush
 leave if @aux='yes' or pmname:d = 'Q'
  screen put_chars getpm.id:d,'PM '+@rtrim(pmname:d)+' does not exist in DBL '+@DBL_NAME+20s,4,8,@scn_noerase,@scn_bold
  screen put_chars getpm.id:d,'Hit any key to continue. ',5,20,@scn_noerase,@scn_bold
  @scn_read_keystroke (getpm.id:d,0) to @integer(20)
  ' ' to pmname:d
  screen delete_chars getpm.id:d,65,4,1
  screen delete_chars getpm.id:d,65,5,1
 repeat
 ! First two lines to create the PM and start the automatic line numbering.
 print 'define pm ',@rtrim(pmname:d),'new'
 print 'insert'
 print '! PM ',@rtrim(pmname:d),'new.'
 print '! RE-created at ',@ftime,' on ',@fdate,' by FIXPAINT2 utility'
 print '! to reduce the size of PMs. Written for Fairfield University.'
 print '!============================================================='
 print '!'
!
!--------------
Routine get.pms
 0 to @integer(20)
 8 to lncnt:d
 screen put_chars main.id:d,5s+'Name'+14s+'Created',lncnt:d,4,@scn_erase,@scn_bold
 incr lncnt:d
 get from x1 first dbl entry PM hush
 screen put_chars main.id:d,entry.type:x1+3s+@rpad(@rtrim(entry.name:x1),15)+3s+@udtstr(create.time:x1),lncnt:d,4,@scn_erase,@scn_normal
 start:2
  get from x1 next dbl entry PM hush
 leave:2 if @aux='missi'
  incr lncnt:d hush
  screen put_chars main.id:d,entry.type:x1+3s+@rpad(@rtrim(entry.name:x1),15)+3s+@udtstr(create.time:x1),lncnt:d,4,@scn_erase,@scn_normal
  if:4 lncnt:d = 15
   screen put_chars main.id:d,"Hit any key for more PM's or 'Q' to stop.",lncnt:d+2,4,@scn_erase,@scn_normal
   @scn_read_keystroke (main.id:d,0) to @integer(20)
   start:5 for lncnt:d= 9 to 18
    screen erase_line main.id:d,lncnt:d,4
   repeat:5
   8 to lncnt:d
  continue:4
 leave:2 if @integer(20)=81,113
 repeat:2
 if @integer(20) ne 81 and 113
  screen put_chars main.id:d,"No more PM's. Hit any key to continue.",lncnt:d+2,4,@scn_erase,@scn_normal
  @scn_read_keystroke (main.id:d,0) to @integer(20)
 continue
 start:8 for lncnt:d= 8 to 18
  screen erase_line main.id:d,lncnt:d,4
 repeat:8
!
!--------------
 Routine display.window
  start:8 for lncnt:d= 1 to 5
   screen erase_line getpm.id:d,lncnt:d,1
  repeat:8
  screen put_chars getpm.id:d,'RE-Writing PM '+pmname:d+' as PM '+pmname+'NEW.  Please wait...',3,3,@scn_erase,@scn_bold
!
!--------------
 Routine get.pm.text
! Routine that writes SF which will be the new PAINT II screen.
 1 to lncnt:d
 start
  get from X1 next dbl text hush
 leave if @aux='missi'
  !
  ! If Layout and not a comment and not already in the CS.
  if:5 (line.text:x1 has "LAYOUT SCREEN") and (line.text:x1 not has '!')
   @left(line.text:x1,500) to lines:d
   get from x2 match by lines:d hush
   if:10 @aux='missi'
    perform writer
    start:12
     get from X1 next dbl text hush
     perform writer
    leave:12 if line.text:x1 has "LAYOUT END"    ! Print until the END.
    repeat:12
   continue:10
  !
  ! If a Routine and not comment -- means in PROCESS section
  ! therfore remain in this loop until all routines have been
  ! re-written.
  orif:5 (line.text:x1 has "ROUTINE") and (line.text:x1 not has '!')
   perform check.rtn
   if:10 flag:d=1
    perform writer
   continue:10
   start:7
    start:12
     get from X1 next dbl text hush
     if:14 line.text:x1 has "ROUTINE"
      perform check.rtn
     continue:14
     perform writer if flag:d=1
    leave:12 if (line.text:x1 has "ROUTINE") or (line.text:x1 has "INITIAL SECTION")
    repeat:12
   leave:7 if line.text:x1 has "INITIAL SECTION"
   repeat:7
   if:6 line.text:x1 eq "INITIAL SECTION"
    print @cr
    print '  ! Include initial commands CS PAINT2 in DBL CENTRAL:SIS.'
    print '  INCLUDE INITIAL.SECTION FROM CS PAINT2 IN DBL CENTRAL:SIS',@cr
   continue:6
  orif:5 line.text:x1 eq "DECLARE SECTION"
   perform writer
   print @cr
   print '  ! Include variables from CS. Code Segment PAINT2 in DBL CENTRAL:SIS.'
   print '  INCLUDE DECLARES FROM CS PAINT2 IN DBL CENTRAL:SIS',@cr
  orif:5 line.text:x1 eq "PROCESS SECTION"
   perform writer
   print @cr
   print '  ! Include routines from CS. Code Segment PAINT2 in DBL CENTRAL:SIS.'
   print '  INCLUDE ROUTINES FROM CS PAINT2 IN DBL CENTRAL:SIS',@cr
  orif:5 (line.text:x1 has "@SCN_READ_KEYSTROKE") and (endr:d =1)
   print @cr
   print '  ! Include main routine for DETAIL SECTION from CS. Code Segment PAINT2 in DBL CENTRAL:SIS.'
   print '  INCLUDE DETAIL.SECTION FROM CS PAINT2 IN DBL CENTRAL:SIS',@cr
  else:5
   if:10 line.text:x1 not begins with '!'
    @left(line.text:x1,500) to lines:d
    get from x2 match by lines:d hush
    if:15 @aux='missi'
     perform writer
    continue:15
   continue:10
  continue:5
 repeat
!
!--------------
Routine check.rtn
 @left(line.text:x1,500) to lines:d
 get from x2 match by lines:d hush
 if @aux='missi'
  1 to flag
 orif @aux='yes'
  0 to flag:d
 continue
!
!--------------
Routine writer
 if (line.text:x1 ne "DETAIL SECTION") !and (line.text:x1 not has '^Z')
  print @rtrim(line.text:x1)
! orif (line.text:x1 has '^Z')
!  print "    'Hit <RETURN> to GET the record' TO MSG.LINE:D"
! else
  1 to endr:d
 continue
!
!===============
initial
screen kill_screen
generate main:d to main.id:d
generate getpm:d to getpm.id:d
screen paste_window main.id:d,4,15
menu main.id:d
!
0 to flag:d
!
!===============
detail
if @menu_choice = 2
 perform get.pm.name
 if:5 pmname:d ne 'Q'
  perform display.window
  perform get.pm.text
 else:5
  "Q" to @string
 continue:5
continue
!
!===============
final
! Last two lines to get out of line insert mode and either save the PM;
! or hold and stop if an error has occured.
if @menu_choice = 2
 print 'end'
 print 'save but hold and stop on error'
 screen unpaste_window getpm.id:d
continue
 screen unpaste_window main.id:d
END
!!This "end" was inserted by			! **REBUILDER CODE**
HOLD						! **REBUILDER CODE**
STOP						! **REBUILDER CODE**
TYPE "(Note: PM PAINT2FIX has not been saved in executable form because"
TYPE "it was not executable prior to using CM FLATTEN.)"
DEFINE PM L.ALL.DS				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! LISTS INFO ABOUT ALL DS'S IN A DBL

CONTROL SECTION
 RELATE DBL FROM COMMAND AS X1 FOR GET

INITIAL SECTION
 START
   GET FROM X1 NEXT DBL ENTRY DS HUSH
   LEAVE IF @AUX<>"YES"
   TYPE @CR,"- ",ENTRY.NAME@""," - ",10S,NOCR
   TYPE "LAST UPDATE ",@UDTSTR(CHANGE.TIME)@""
   TYPE "TOTAL RECORDS ",TOTAL.REC@"5Z",3S,NOCR
   TYPE "DELETED RECORDS ",DELETED.REC@"5Z",3S,NOCR
   TYPE "VALID RECORDS ",TOTAL.REC-DELETED.REC@"5Z"
   TYPE
 REPEAT
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM L.FST.10.LIN				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! LISTS INFO ABOUT ALL PM'S IN A DBL

CONTROL SECTION
 RELATE DBL FROM COMMAND AS X1 FOR GET
   RELATE SF 10.LIN AS REPORT 1
DECLARE SECTION
  II,I,2

INITIAL SECTION
 START
   GET FROM X1 NEXT DBL ENTRY PM HUSH
   LEAVE IF @AUX<>"YES"
   PRINT @CR,"- ",ENTRY.NAME@""," - ",10S,NOCR
   PRINT "LAST UPDATE ",@UDTSTR(CHANGE.TIME)@""
   START:20 FOR II=1 TO 15
       GET FROM X1 NEXT TEXT HUSH
       PRINT @RTRIM LINE.TEXT
   REPEAT:20
 REPEAT
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM TPU					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
INITIAL
'ED/TPU' TO @EDITOR
TYPE @CR,'@Editor is now initialized for TPU...'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM EDT					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
INITIAL
'ED/EDT' TO @EDITOR
TYPE @CR,'@Editor is now initialized for EDT...'
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM CMD_GLOBS				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM CMD_GLOBS	saves/restores system globals according to what's in %Saved:
!		Must be called from CM CMD_INIT or CM CMD_FINI in this DBL

!	A		@interrupts_cm and @abort_cm => "ABORT_"+%Verb
! 	C		@command
!	S( \\n\\ )	@string's	\
!	N( \\n\\ )	@number's	 \	Each n is 1-25.
!	V( \\n\\ )	@vdate's	 /
!	I( \\n\\ )	@integer's	/
!
!	Example: "CS(1,2,3)I(7)" saves @command, @string(1-3) and @integer(7).

CONTROL
relate GS CMDS as CMDS

DECLARE
C,c,1		! Current char in %Saved
G,c,1		! Current global to save
S,i,max		! Subscript of current global
N,i,max		! Current position in %Saved
W,i,1,use values 0="INIT", 1="FINI"

INITIAL
exit process if @cm_dbl<>@pm_dbl
start for N = 0 to 1
	N to W
leave if @right(@rtrim(@cm_name),4)=(&&W)
repeat
if N=2
	store "use no CM" in command area
	type @cr,"Command improperly begun/ended",@cr
	exit process
continue

DETAIL
"" to G
0 to N,S
start
	1+N to N
leave if N > @len(%Saved)

	@substr(%Saved,N,1) to C

	if:1 C="A"
		if:2 W=0
			@interrupts_cm to %Interrupts_CM
			@abort_cm to %Abort_CM
			"ABORT_"+%Verb to @interrupts_cm, @abort_cm
		else:2
			%Interrupts_CM to @interrupts_cm
			%Abort_CM to @abort_cm
		continue:2

	orif:1 C="C"
		@command to %Command if W=0
		%Command to @command if W=1

	orif:1 C in "SNVI"
		C to G		! Keep which global in G

	orif:1 C="(",","	! Begin subscript: S will be it
		@ival( @extract(%Saved,",)",N+1) ) to S
		@token_pos-1 to N

		if:2 G="S"
			@string(S) to %String(S) if W=0
			%String(S) to @string(S) if W=1
		orif:2 G="N"
			@number(S) to %Number(S) if W=0
			%Number(S) to @number(S) if W=1
		orif:2 G="V"
			@vdate(S) to %Vdate(S) if W=0
			%Vdate(S) to @vdate(S) if W=1
		orif:2 G="I"
			@integer(S) to %Integer(S) if W=0
			%Integer(S) to @integer(S) if W=1
		continue:2

	orif:1 C=")"		! End of subscript list
		"" to G
		0 to S

	else:1
		type @cr,"*** Bad "+@pm_name+" letter: ",C," ***"
leave	!	!
	continue:1
repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM XFER					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM XFER	used to make a command file to define and save an item from a
!		file with the former item's text.  The item name, possibly with
!		an IN DBL clause, must be in @command when this is run.
!		It simply puts DEFINE and INSERT commands on top, and END/SAVE
!		commands on the bottom.

CONTROL
relate DS ###XFER as Master
relate SF from command as report 1

INITIAL
turn fill off
print "SET 0 TO @ERROR_NUMBER"
print "SET '' TO @COMMAND"
print "DEFINE",1s,@command@""
print "STOP"
print "SET 'USE NO SF' TO @COMMAND IF @ERROR_NUMBER>0"
print "DISABLE ERROR ABORT"
print "$@COMMAND"
print "DEFINE",1s,@command@""
print "INSERT"

DETAIL
print Lyne@""

FINAL
print "END"
print "SAVE HOLD STOP"
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM FINDR					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
Control
 relate dbl from command as x1 for GET
 relate sf  findr.dat    as report 1
!
Declare
 entry.types, c,  2, occurs 10
 item.type,   c,  2
 name,        c, 40
 text.found,  i,  1
 tot.items,   i,  1
 loop.cntr,   i,  4
 type.cntr,   i,  4
 tot.finds,   i,  4
 type.ent,    c,  2
 allent,      i,  1
!
Initial
 'SD' to entry.types:d(1)
 'DI' to entry.types:d(2)
 'CS' to entry.types:d(3)
 'SF' to entry.types:d(4)
 'ID' to entry.types:d(5)
 'SI' to entry.types:d(6)
 'CF' to entry.types:d(7)
 'PM' to entry.types:d(8)
 'CM' to entry.types:d(9)
 'GS' to entry.types:d(10)
 0 to text.found,tot.items,allent,loop.cntr
 1 to type.cntr
 turn fill off
 60 to @lines
 type @cr,78'*',@cr
 type @cr,@cr,'You are in <<< DBL ',@DBL_NAME@'',' >>>',@CR
 print @cr,'This file created on : ',@fdate,' at ',@ftime
 print @cr,'by user: ',@rtrim(@user),' in DBL ',@rtrim(@dbl_name),@cr,@cr
 !
 start
  start:2
   '' to item.type:d
   0 to allent:d
   type @cr,'Enter ITEM (ie:CM,PM) to search;'
   type '<CR>=search all items; "Q"=QUIT: ',nocr
   accept item.type:D
   1 to allent if item.type=' '
  leave:2 if item.type:d='PM','CM','SD','DI','CF',&
                          'SI','CS','GS','SF',' ','Q'
  repeat:2
  !
  @uc item.type to item.type
 leave if item.type:D='Q'
 exit process if item.type:D='Q'
  !
  entry.types:d(type.cntr) to item.type:d if item.type:d=' '
  !
  'n' to @string(2)
  start:5
   type @cr,'Enter string to search for (XXX to quit): ',nocr
   accept @string
  exit process if @string='xxx'
   if:10 @string gt ''
    transmit ascii from @esc+'[4m'
    type '--->',nocr
    transmit ascii from @esc+'[0m'
    transmit ascii from @esc+'[5m'
    type @rtrim(@string),nocr
    transmit ascii from @esc+'[0m'
    transmit ascii from @esc+'[4m'
    type '<---',nocr
    transmit ascii from @esc+'[0m'
    type '  Correct search string ? (Y/N) [Y]: ',NOCR
    accept @string(2)
   continue:10
  leave:5 if @string(2)='y',' '
  repeat:5
  !
  type @cr
  0 to loop.cntr:d
  start:10
   start:15
    0 to text.found:d
    !
    if:20 item.type:d='SD'
     get from x1 next dbl entry SD hush
    orif:20 item.type:d='DI'
     get from x1 next dbl entry DI hush
    orif:20 item.type:d='CS'
     get from x1 next dbl entry CS hush
    orif:20 item.type:d='SF'
     get from x1 next dbl entry SF hush
    orif:20 item.type:d='ID'
     get from x1 next dbl entry ID hush
    orif:20 item.type:d='SI'
     get from x1 next dbl entry SI hush
    orif:20 item.type:d='CF'
     get from x1 next dbl entry CF hush
    orif:20 item.type:d='PM'
     get from x1 next dbl entry PM hush
    orif:20 item.type:d='CM'
     get from x1 next dbl entry CM hush
    continue:20
!    incr loop.cntr:d if @aux='missi' and allent=1
    incr loop.cntr:d if @aux='yes' !and allent=0
   leave:15 if @aux='missi'
    !
    !
    entry.name:x1 to name:d hush
    entry.type:x1 to type.ent:d hush
    !
    type 'Searching through  ',entry.type,1s,@rtrim(name:d),' for  "',NOCR
    transmit ascii from @esc+'[4m'
    type @rtrim(@string),'"',nocr
    transmit ascii from @esc+'[0m'
    type '.',nocr
    !
    start:25
     get from X1 next text hush
    leave:25 if @aux='missi'
     if:30 line.text:x1 has @string
      1 to text.found
      incr tot.finds,tot.items
      type '.',nocr
     continue:30
    repeat:25
    type ''
    !
    if:40 text.found:d=1
     print 'STRING "',@rtrim(@string),'" found in ',type.ent,1s,@rtrim(name:d),&
           ' in DBL ',@rtrim(@dbl_name),@cr
     type ' ** STRING  "',nocr
     transmit ascii from @esc+'[4m'
     type @rtrim(@STRING),nocr
     transmit ascii from @esc+'[0m'
     type '"  found in ',type.ent,1s,@rtrim(name:d),' **',nocr
     accept @string(23)
   continue:40
   !
  repeat:15
   !
   incr type.cntr:d
   !
  leave:10 if type.cntr = 10 or allent= 0
   entry.types:d(type.cntr) to item.type:d
  !
  repeat:10
  !
  type @cr,@cr,' STRING  "',@rtrim(@STRING),'"  not found in any ',nocr if tot.items:d=0 and loop.cntr gt 0
  type type.ent,' in DBL ',@rtrim(@dbl_name),' ,Sorry...' if tot.items:d = 0 and loop.cntr gt 0 and allent=0
  type 'DBL entry.types in DBL ',@rtrim(@dbl_name),' ,Sorry...' if tot.items:d = 0 and loop.cntr gt 0 and allent=1
  !
  type @cr,@cr,' STRING "',@rtrim(@string),'" found ',tot.finds,' time(s) in ',loop.cntr,1s,nocr if tot.finds gt 0
  type type.ent,"(s)" if allent=0 and tot.finds gt 0
  type ' DBL entry.types...' if allent:d=1 and tot.finds gt 0
  type @cr,' NO ',item.type,'(s) found in dbl ',@dbl_name if tot.finds=0 and loop.cntr=0
  0 to tot.finds:d,loop.cntr:d
  0 to text.found,tot.items,allent,loop.cntr
  1 to type.cntr
  !
 repeat
!
Final
 type @cr
 type @cr,'* Print out file FINDR.DAT for listing of found strings... *'
 type @cr
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM SD					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
INITIAL
TYPE @CR,'You are logged in as ',@USER@'',' and are using DBL ',@DBL_NAME@'','.'
@INDEX(@CONNECTED,'[') TO @INTEGER(20)
@INTEGER(20)+1 TO @INTEGER(20)
@INDEX(@CONNECTED,']') TO @INTEGER(21)
@INTEGER(21)-@INTEGER(20) TO @INTEGER(22)
IF @SUBSTR(@CONNECTED,@INTEGER(20),@INTEGER(22)) NE @USER
 TYPE 'You are connected to ',@connected@'','.'
CONTINUE
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE SI EC.CMDS				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
When proceeding to a new version of Accent r the system file
FAIRFIELD.CMD in the previous DUA0:[ACCENTV100n] account
should be copied to the new directory DUA0:[ACCENTV100n].
The DBL ECMD (system file ECMD.DBL) should also be copied to
the new DUA0:[ACCENTV100n] because all of the programs that
the Fairfield equatesread are located with the logical NIS:ECMD.

After the FAIRFIELD.CMD and the ECMD.DBL files are copied into the
DUA0:[ACCENTV100n] account, the system file EC.CMD should be edited
and the FAIRFIELD.CMD file should be inserted into it where the
equates are defined.  Accent should be run and the following line
typed "USE SF EC.CMD" this re-writes the ACCENT.MSG file and then
when Accent is run the equates will be usable.
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE SI HELP_XFER				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
XFER	copies text items to SF's and back, allows listing files/items
====	==============================================================
Usage:	XFER [ xfer_command ]

Where:	xfer_command is one of:
		HELP, ?		types this help
		FILE item	copies text of item to item_file
		KILL item	removes item ONLY if item_file exists
		LIST item	does just that
		MAKE item	makes item anew with text in item_file
		TYPE item	types the item_file, NOT the item

	item		is type name [ in DBL dbl ]

	item_file	is a file named after the item, as in the examples.

If the command line is empty, the user is repeatedly prompted for XFER
commands until a blank line is typed.

E.g.:	XFER FILE PM FOO	makes SF PM_FOO.TMP from PM FOO

	XFER MAKE PM FOO	makes PM FOO from text in SF PM_FOO.TMP
	
		BUT: PM FOO must not exist, so...

	XFER KILL PM FOO	removes PM FOO ONLY if PM_FOO.TMP exists

Notes:	The IN DBL clause is NOT incorporated into the name of the SF
	created or used:  if you have two DBL's with a PM FOO, then if
	you XFER FILE PM FOO with each DBL in use, you will create
	PM_FOO.TMP;0 both times.
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DONE						! **REBUILDER CODE**