******************************************************************************* *
*	uniVerse port of PI/open ENTRO subroutine
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenance log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	04/15/96 18272 LDG Distinguish bad conv check message from pattern
*	07/13/95 16907 EAP Use UNISEQ() for NLS support
*	05/18/95 15741 EAP Added error message for NLS write errors
*	05/16/95 15741 EAP Added error message for NLS unmappable Ids
*	09/15/93 12031 PVW Handle "top" to be the same as "TOP"
*	07/02/93 11778 PVW Handle insert syntax >#n correctly
*	07/01/93 11772 PVW Handling of SQL NULL character fixed
*	06/29/93 11741 PVW Handle SQL Integrity Constraint Violations
*	06/01/93 11645 PVW Remove DEVSYS.STRIPSTRS.MODE from code
*	02/23/93 11107 PVW Fix revise handling of sql null.
*	02/19/93 11008 PVW Put check on readu of invalid part file records.
*	01/27/93 10953 PVW Let NULL string be entered where a conversion
*	                   code is specified as valid data.
*	01/04/92 10800 PVW Accept upper and lower case commands.
*	12/31/92 10213 PVW Set DEVSYS.STRIPSTRS.MODE to "Revise"
*	12/07/92 10213 PVW Change INMAT statements and upcase(top)
*	12/03/92 10213 PVW Make page length fo discussions term depth.
*	12/03/92 10213 PVW Change REVISE.CHANGE(L) to REVISE*CHANGE(L).
*	11/12/92 10213 PVW Port PI/open ENTRO to replace uniVerse REVISE.
*
*******************************************************************************

$OPTIONS INFORMATION

$INCLUDE UNIVERSE.INCLUDE VERBINSERT.H
$INCLUDE UNIVERSE.INCLUDE SYMBOL.TBL.H
$INCLUDE UNIVERSE.INCLUDE UV.COM
$INCLUDE UNIVERSE.INCLUDE KEYWORD.H
$INCLUDE UNIVERSE.INCLUDE REVISE.H

      @SYSTEM.SET = 0
      STRIPSTRINGS = '-STRIPSTRINGS'
      FINDFILE = '-FINDFILE'
      EXPAND = '-EXPAND'
      SQLINTCHK = '-SQLINTCHK'

      EQU IntegrityViolation TO -3
      EQU UpdateExisting TO 1
      EQU UpdateNew TO 2

*******************************************************************************
*
*     The following lines of code are included to setup this program
*     with the same input as the PI/open ENTRO.B subroutine receives
*     from the PI/open command line processor PERFORM.B.
*
*     SUBROUTINE REVISE (SENTENCE, MAT SYMBOLS)
*
      DIM SYMBOLS (VALSTART + MAXTOKENS)

      SENTENCE = @SENTENCE
      SENTENCE = TRIMF(SENTENCE)
      TOKEN.1 = FIELD(SENTENCE," ",1)
      IF TOKEN.1 = "RUN" OR TOKEN.1 = "RAID" THEN
         SENTENCE = FIELD(SENTENCE," ",3,9999)
      END

      MAT SYMBOLS = ''

      SYMBOLS (NEXT.TKN.VALUE) = VALSTART
      SYMBOLS (ORIGINAL.SENTENCE) = SENTENCE

      OPEN "VOC" TO DEVSYS.VOC.FILE ELSE
         CALL *UVPRINTMSG(001752,"")
         STOP
      END

      DEVSYS.FILE.FOUND = 0
      DEVSYS.DICT.SWITCH = 0

      IF INDEX(SENTENCE,'"',1) + INDEX(SENTENCE,"'",1) THEN
         CALL @STRIPSTRINGS (SENTENCE, MAT SYMBOLS)
      END

      HOLD.SENTENCE = SENTENCE
      ERROR.CODE = 0

      CALL @FINDFILE (HOLD.SENTENCE, MAT SYMBOLS, ERROR.CODE)

      IF ERROR.CODE THEN GO 9920

      POS = SYMBOLS (NEXT.TKN.VALUE)
      SYMBOLS (VERB) = FIELD(SENTENCE,' ',1):@VM:POS
      SYMBOLS (NEXT.TKN.VALUE) += 1
      SYMBOLS (POS) = '-REVISE':@FM:'IN'
      OUTBUF = CHAR(VERB):POS

      HOLD.SENTENCE = FIELD(HOLD.SENTENCE, ' ', 2, 9999)
      IF HOLD.SENTENCE # '' THEN
         CALL @EXPAND (HOLD.SENTENCE, OUTBUF, MAT SYMBOLS, ERROR.CODE)
         IF ERROR.CODE THEN GO 9920
         SENTENCE = OUTBUF
      END

*******************************************************************************
!
*          S T A N D A R D   F I E L D   V A R I A B L E S
!
*        TERMINAL CONTROL CHARACTERS
*
      PROMPT ' '
*        SUBROUTINE ENTRY POINTS
      IP = 1                             ; *PROMPT ENTRY POINT FOR PROMPTER
      EP = 2                             ; *ERROR MESSAGE ENTRY POINT FOR PROMPTER
* STANDARD RESPONSES
      STD.RESP0=@FM:@FM:RV$CMD.TOP:@FM:RV$CMD.HELP:@FM:RV$CMD.EXTENDED.HELP:@FM:RV$CMD.PROMPT:@FM:RV$CMD.REDRAW:@FM:RV$CMD.SKIP:@FM          ; *006
      STD.RESP = STD.RESP0:RV$CMD.DELETE:@FM       ; *006
      STD2.RESP=@FM:@FM:'>':@FM:'##':@FM:'"':@FM   ; * SECOND SCREEN CONVENTIONS  ;*006
* ARRAYS
      ITYPE = ''                         ; * ITYPE FLAG FOR TESTING ITYPES FOR PI/PC    PRT  ;*009
      DTYPE = ''                         ; * DTYPE FLAG FOR TESTING DTYPES FOR PI/PC    PRT  ;*009
      MAX.PMTS = 50
      DIM D.D(MAX.PMTS),INP(MAX.PMTS),RFMT(MAX.PMTS),LFMT(MAX.PMTS),CV(MAX.PMTS),LAST.IN(MAX.PMTS),OLD(MAX.PMTS)
      DIM VERIFILE(MAX.PMTS),VERIFY(MAX.PMTS),LAST.INPUT(MAX.PMTS),START.SCR(10),END.SCR(10)
      DIM MACRO(2), ITEM.ARRAY(50)       ; * ITEM.ARRAY is used with CLEAR.OPCODES;*009
                                         ; * routine                         ;*009
      CHANGE=@AM:'CHANGE':@AM:@AM:'(1,99)':@SVM:'"DELETE"'
      CHANGE:=@SVM:'"TOP"':@SVM:'"?"':@SVM:'"QUIT"':@AM:'O':@AM:@AM:@AM:@AM:@AM
      CHG = UVREADMSG(001585,"")
      CHANGE := CHG
10:* OPEN FILES AND BEGIN PROCESSING
      WDN=2
      FNAME=''
      PROCESS=''
      DICT=''
      NEXT.AVAILABLE=0                   ; * FLAG TO USE NEXT AVAILABLE SEQUENTIAL ID
      ADD.FLAG=1                         ; * FLAG FOR WINDOW LOGIC ALSO ENFORCES REQUIRED PROMPTING
      NO.WDS=COUNT(SENTENCE,' ')+1
      IF FIELD(SENTENCE,' ',2) EQ '' THEN GO PROMPT.
      WD.LAST=''
      FOR WDN=2 TO NO.WDS
         WD=FIELD(SENTENCE,' ',WDN)
         SNO=WD[2,99]
         IF UNISEQ(WD)=KEYWORD THEN
            OP.CODE = SYMBOLS(SNO)<1>
            IF OP.CODE = KW$DICT THEN DICT=1 ; IF FNAME THEN GO AROUND.GET.NAME ELSE GO 2
            IF OP.CODE = KW$USING THEN   ; * 'USING' CLAUSE
               GOSUB GET.NEXT.WD
               IF TYPE EQ FILE THEN
                  GOSUB GET.NAME
                  PROCESS.FNAME=GOT.NAME
                  GOSUB GET.NEXT.WD
               END ELSE PROCESS.FNAME=REVISE.PROCESSES
               GOSUB GET.NAME
               PROCESS=GOT.NAME
               GO 2
            END
            IF OP.CODE = KW$VERIFIELD THEN         ; * VERIFIELD KEYWORD
               GOSUB GET.NEXT.WD
               IF TYPE = NOUN THEN       ; * MAKE SURE VERIFIELD FIELD IS NOT PROMPTED FOR
                  IF NOT(INDEX(SENTENCE,SNO,2)) THEN         ; * ONLY APPEARS ONCE IN SENTENCE
                     I=1
                     LOOP Q=SYMBOLS(NOUN)<I> UNTIL Q="" DO
                        IF Q<0,2>=SNO THEN
                           SYMBOLS(NOUN)=DELETE(SYMBOLS(NOUN),I,0,0)
                           SYMBOLS(VALUE)=INSERT(SYMBOLS(VALUE),-1,0,0,Q)
                           SYMBOLS(SNO)=""
                           SENTENCE[COL1() + 1,1]=CHAR(VALUE)
                           GOTO 2
                        END
                        I+=1
                     REPEAT
                  END
               END
            END
            IF OP.CODE = KW$TEMPLATE THEN          ; * TEMPLATE
               GOSUB GET.NEXT.WD
               IF TYPE=FILE THEN GO 2    ; * SKIP IT
               WDN-=1
               GO 2
            END
         END ELSE
            IF UNISEQ(WD) EQ FILE THEN
               IF UNISEQ(WD.LAST)=KEYWORD THEN
                  IF SYMBOLS(WD.LAST[2,99])<1,1> EQ KW$VERIFILE THEN GO 2        ; * VERIFILE
                  IF SYMBOLS(WD.LAST[2,99])<1,1> EQ KW$USING THEN GO 2           ; * PROCESS FILE
                  IF SYMBOLS(WD.LAST[2,99])<1,1> EQ KW$TEMPLATE THEN GO 2        ; * TEMPLATE FILE
               END
               GOSUB GET.NAME
               FNAME=GOT.NAME
               IF DICT THEN GO AROUND.GET.NAME     ; * ALL SET FOR NOW
            END
         END
2:       WD.LAST=WD
      NEXT WDN
      GO AROUND.GET.NAME

GET.NAME:
      I = 1
      X = UNISEQ(WD)
      LOOP Q = SYMBOLS(X)<I,2> UNTIL Q='' DO
         IF Q = SNO THEN
            GOT.NAME=SYMBOLS(X)<I,1>
            RETURN
         END
         I+=1
      REPEAT
      @SYSTEM.SET = -1
      PRINT "REVISE.Symbol Table error. Token =>":WDN:"<= not found in Type =>":UNISEQ(WD):"<="
      GO 9920

GET.NEXT.WD:
      WDN+=1
      IF WDN GT NO.WDS THEN GO PREMATURE
      WD=FIELD(SENTENCE,' ',WDN)
      TYPE=UNISEQ(WD)
      SNO=WD[2,99]
      RETURN

PREMATURE:
      @SYSTEM.SET = -1
      PRINT "Your sentence ended prematurely."
      GO 9920

GET.PMT:
      * ROUTINE TO FIND PRECEDENT FIELD NAME AND PROMPT NUMBER
      PMT=''
      IF LAST.PMT='' THEN RETURN
      FOR PMT=1 TO NO.PMTS
         IF D.D(PMT)<1,RV$PRO.FLD.NAME> EQ LAST.PMT THEN RETURN
      NEXT PMT
      PMT=''
      RETURN

AROUND.GET.NAME:
      IF FIELD(SENTENCE,' ',2) EQ '' THEN GO PROMPT.
      IF DICT THEN IF FNAME THEN FNAME='DICT ':FNAME
      IF PROCESS THEN GO PROMPT.
      IF FNAME='' THEN
         @SYSTEM.SET = -1
         PRINT "This REVISE.sentence has neither a File Name nor a PROCDEF."
         GO 9920
      END
      IF FNAME THEN GOSUB FNAME.         ; * OPEN FILES
      IF FNAME='' THEN RETURN            ; * BAD FILE NAME
      IF DICT THEN PROCESS = 'ENTER.DICT' ; GO PROMPT.
      GO 20
PROMPT.:IF PROCESS = '' THEN
5:       CALL *UVPRINTMSG(001609,"")     ; * enter process name
         INPUT PROCESS
         IF PROCESS = RV$CMD.HELP THEN PRINT "Enter the name of the PROCDEF you wish to use,  or  END to quit." ; GO 5
         IF PROCESS='' OR UPCASE(PROCESS) = RV$CMD.END THEN RETURN
      END
      OPENCHECK '',REVISE.PROCESSES TO PROCESS.FILE ELSE
         OPENCHECK '','NEWACC' TO NEWACC.FILE ELSE
            PRINT "Can't open NEWACC"
            RETURN
         END
         READ NEWACC.RECORD FROM NEWACC.FILE,REVISE.PROCESSES ELSE
            PRINT "Can't find ":REVISE.PROCESSES
            RETURN
         END
         * --- Write the record out to the VOC.
         WRITE NEWACC.RECORD TO DEVSYS.VOC.FILE,REVISE.PROCESSES
         OPENCHECK '',REVISE.PROCESSES TO PROCESS.FILE ELSE
            CALL *UVPRINTMSG(001601,REVISE.PROCESSES)
            RETURN
         END
      END
      READ PROCESS.ITEM FROM PROCESS.FILE , PROCESS ELSE
         CALL *UVPRINTMSG(001602,PROCESS:@FM:REVISE.PROCESSES)
         GO 5
      END
      IF PROCESS.ITEM<RV$PRO.FILE.NAME> NE '' THEN
         IF FNAME THEN IF FNAME NE PROCESS.ITEM<RV$PRO.FILE.NAME> THEN
            @SYSTEM.SET = -1
            PRINT "This Process Definition specifies only file ":PROCESS.ITEM<2>
            GO 9920
         END
         FNAME=PROCESS.ITEM<RV$PRO.FILE.NAME>
      END
      IF FNAME='' THEN
11:      CALL *UVPRINTMSG(001603,"")     ; * enter file name
         INPUT FNAME
         IF FNAME='' THEN GO 5
         IF FNAME='?' THEN PRINT "Enter the name of the file you wish to modify." ; GO 11
      END
      GOSUB FNAME. ; IF FNAME='' THEN RETURN ELSE GO 20
FNAME.:
      IF FIELD(FNAME,' ',1)='DICT' THEN
         X='DICT'
         Q=FIELD(FNAME,' ',2)
      END ELSE
         X=''
         Q=FNAME
      END
      OPENCHECK X,Q TO DATA.FILE ELSE
15:      X.TEXT = 'DICT '
         IF X = 'DICT' THEN X.TEXT = ''
* Cannot open file
         CALL *UVPRINTMSG(001601,X.TEXT:Q)

         * --- Ensure that @SYSTEM.RETURN.CODE reflects the error. (SPAR 4034265).
         @SYSTEM.SET = -1

         FNAME='' ; RETURN
      END
      UpdateFilename = X:Q
      OPENCHECK 'DICT',Q TO DICT.DATA.FILE ELSE
         @SYSTEM.SET = -1
* Cannot open file
         CALL *UVPRINTMSG(001601,'DICT ':Q)
         GO 9920
      END
      RETURN
20:*
*
* GET SCREEN TITLE ,NUMBER OF ATTRIBUTES AND AMC OF BATCH TOTAL IF ANY
*
      IF PROCESS NE '' THEN TITLE=PROCESS.ITEM<RV$PRO.TITLE> ELSE PROCESS.ITEM='' ; TITLE=FNAME
      BATCH.TOTAL.AMC=PROCESS.ITEM<RV$PRO.BATCH.TOTAL.AMC>
      BATCH.AMC=PROCESS.ITEM<RV$PRO.BATCH.AMC>
      ENTRY.DATE.AMC=PROCESS.ITEM<RV$PRO.ENTRY.DATE.AMC>
      AUDIT.FILE=PROCESS.ITEM<RV$PRO.AUDIT.FILE>
      IF AUDIT.FILE NE '' THEN
         OPENCHECK '',AUDIT.FILE TO AF ELSE
            PRINT @SYS.BELL:"Audit File",AUDIT.FILE,"is not defined on this Account." ; RETURN
         END
      END
      MAX.LINES=10                       ; * MAXIMUM NUMBER OF LINE ITEMS PER SECOND SCREEN FORMAT
*
* INITIALIZE BATCH TOTAL
*
      BATCH.TOTAL=''
      BATCH.NO=''                        ; * UNTIL NEEDED
      FROM.SC2=''
      X=@(0)                             ; * SHUT DOWN PAGING
      NEXT.FILE=1
      USING.NEXT.AVAILABLE=''
      DISC.FILE.NOT.OPEN = 1             ; * NO NEED TO OPEN THE DISCUSSIONS FILE UNTIL NECESSARY
*
!
*
* DEVELOP PROMPTS
*
      NO.PMTS=''
      X=''
      MAT D.D=''
      MAT LAST.IN=''
      MAT LAST.INPUT=''
      MAT START.SCR=''
      MAT END.SCR=''
      MAT OLD=''
      MAX.FMC=''
!
!
      IF PROCESS EQ '' THEN
         CALL @REVISE.ASSOC (MAT SYMBOLS,MAT MACRO,SENTENCE,NOUN,MAT D.D,PROCESS.ITEM,MAT VERIFY,
            STRIPSTRINGS,EXPAND,DICT.DATA.FILE,FNAME,ORIGINAL.SENTENCE,NO.PMTS,MAX.PMTS)
         NO.WDS=COUNT(SENTENCE,' ')+1
* CHECK FOR TEMPLATES, VERIFILES, VERIFIELDS AND MATCHINGS
         LAST.PMT=''                     ; * FIELD NAME OF THE CURRENT PROMPT
         FOR WDN=2 TO NO.WDS
            WD=FIELD(SENTENCE,' ',WDN)
            SNO=WD[2,99]
            IF UNISEQ(WD) EQ NOUN THEN      ; * KEEP TRACK OF WHAT FIELD IS BEING MODIFIED
               GOSUB GET.NAME
               LAST.PMT=GOT.NAME
               GO NEXT.WD
            END
            IF UNISEQ(WD) NE KEYWORD THEN GO NEXT.WD
            OP.CODE = SYMBOLS(SNO)<1>

            IF OP.CODE = KW$USING THEN
               GOSUB GET.NEXT.WD
               IF TYPE EQ FILE THEN
                  GOSUB GET.NAME
                  PROCESS.FNAME=GOT.NAME
                  GOSUB GET.NEXT.WD
               END ELSE
                  PROCESS.FNAME=REVISE.PROCESSES
               END
               GOSUB GET.NAME
               PROCESS=GOT.NAME
               GO NEXT.WD
            END

            IF OP.CODE = KW$VERIFILE THEN
               GOSUB GET.NEXT.WD
               GOSUB GET.NAME
               IF TYPE NE FILE THEN
                  @SYSTEM.SET = -1
                  CALL *UVPRINTMSG(001590,GOT.NAME)          ; * invalid verification file
                  GO 9920
               END
               GOSUB GET.PMT
               IF PMT='' THEN
                  @SYSTEM.SET = -1
                  PRINT "Verifile ":GOT.NAME:" doesn't address a field."
                  GO 9920
               END
               D.D(PMT)<1,RV$PRO.FLD.VERIFILE> = GOT.NAME
               IF WDN GE NO.WDS THEN GO NEXT.WD
               GOSUB GET.NEXT.WD
               IF TYPE NE KEYWORD THEN WDN-=1 ; GO NEXT.WD
               SNO=WD[2,99]
               OP.CODE = SYMBOLS(SNO)<1>

               IF OP.CODE NE KW$VERIFIELD THEN WDN-=1 ; GO NEXT.WD
               IF FIELD(GOT.NAME,' ',1) EQ 'DICT' THEN
                  X=''
                  VFNAME='DICT.DICT'
               END ELSE
                  X='DICT'
                  VFNAME=GOT.NAME
               END
               OPENCHECK X,VFNAME TO VFILE ELSE
                  @SYSTEM.SET = -1
* Dictionary of verification file ":VFNAME:" not found."
                  CALL *UVPRINTMSG(001593,VFNAME)
                  GO 9920
               END
               GOSUB GET.NEXT.WD
               GOSUB GET.NAME
               READ X FROM VFILE,GOT.NAME ELSE
                  @SYSTEM.SET = -1
* Verification field not found on dictionary of file
                  CALL *UVPRINTMSG(001594,GOT.NAME:@FM:VFNAME)
                  GO 9920
               END
               FMC=X<2>
               IF X[1,1] NE 'D' OR NOT(NUM(FMC)) THEN
                  @SYSTEM.SET = -1
* Verification field is not a data definition on the dictionary of file
                  CALL *UVPRINTMSG(001595,GOT.NAME:@FM:VFNAME)
                  GO 9920
               END
               D.D(PMT)<1,RV$PRO.FLD.VERIFIELD> = FMC+0
            END

            IF OP.CODE = KW$MATCHING THEN          ; * MATCHING
               GOSUB GET.NEXT.WD
               GOSUB GET.NAME
               GOSUB GET.PMT
               IF PMT='' THEN
                  @SYSTEM.SET = -1
* Matching clause must follow a field name
                  CALL *UVPRINTMSG(001591,"")
                  GO 9920
               END
               D.D(PMT)<1,RV$PRO.FLD.MATCHFIELD> = GOT.NAME
            END

            IF OP.CODE = KW$NEXT.AVAILABLE THEN    ; * NEXT.AVAILABLE
               D.D(1)<1,RV$PRO.FLD.REQUIRED> = RV$PRO.VAL.NEXTAVAILABLE
               NEXT.AVAILABLE=1          ; * FLAG
            END

NEXT.WD: NEXT WDN
         IF PROCESS THEN GO PROMPT.      ; * SOMEBODY USED A 'USING' IN AN '@' PHRASE
         GO FIGGER
      END ELSE
         MATPARSE D.D FROM FIELD(PROCESS.ITEM,@FM,RV$PRO.FLD.BEG,RV$PRO.FLD.END),@FM
         NO.PMTS=INMAT()<1,1>
         GO FIGGER
      END
!
!
FIGGER:IF NO.PMTS=0 THEN PRINT "####### No prompts found for this File ######" ; RETURN
      FILE.ERR=0
      FOR PMT=1 TO NO.PMTS
         VERIFY(PMT)=''                  ; * FLAG FOR FILE VERIFICATION
         REFILE=D.D(PMT)<1,RV$PRO.FLD.VERIFILE>    ; * VERIFICATION FILE NAME
         REFL=1                          ; * VERIFILE
         GOSUB 60
         REFILE=D.D(PMT)<1,RV$PRO.FLD.PASSIVE.XREF>
         REFL=2                          ; * REFILE - PASSIVE CROSS REFERENCE FILE
         GOSUB 60
         REFILE=D.D(PMT)<1,RV$PRO.FLD.ACTIVE.XREF>
         REFL=3                          ; * CREFILE - ACTIVE CROSS REFERENCE FILE
         GOSUB 60
         GO 65
60:* OPENING REFERENCE AND VERIFICATION FILES
         IF REFILE='' THEN RETURN
         IF FIELD(REFILE,' ',1)='DICT' THEN
            DX='DICT'
            X=FIELD(REFILE,' ',2)
         END ELSE
            DX=''
            X=REFILE
         END
         OPENCHECK DX,X TO VERIFILE(NEXT.FILE) ELSE
            FILE.ERR=1
            DX.TEXT = 'DICT '
            IF DX = '' THEN DX.TEXT = ''
* Verficiation file is not a valid file
            CALL *UVPRINTMSG(001590,DX.TEXT:X)
            RETURN
         END
         VERIFY(PMT)<1,REFL> = NEXT.FILE
         NEXT.FILE=NEXT.FILE+1
         RETURN
65:* AFTER VERIFILE PROCESSING
         IF FILE.ERR THEN
            @SYSTEM.SET = -1
            GO 9920
         END
         IF D.D(PMT)<1,RV$PRO.FLD.ASSOCIATION> THEN LAST.IN(PMT)=1
         Q=D.D(PMT)<1,RV$PRO.FLD.SCREEN.NO>
         IF NOT(Q) THEN Q=1
         IF Q > INMAT(START.SCR)<1,1> THEN
            DIM START.SCR(Q + 5)
            DIM END.SCR(Q + 5)
            FOR X = Q TO Q+5
               START.SCR(X)=''
               END.SCR(X)=''
            NEXT X
         END
         IF START.SCR(Q)='' THEN START.SCR(Q)=PMT
         IF PMT LT START.SCR(Q) THEN START.SCR(Q)=PMT
         IF END.SCR(Q)='' THEN END.SCR(Q)=PMT
         IF PMT GT END.SCR(Q) THEN END.SCR(Q)=PMT
         IF D.D(PMT)<1,RV$PRO.FLD.LOCATION> > MAX.FMC THEN MAX.FMC=D.D(PMT)<1,RV$PRO.FLD.LOCATION>
      NEXT PMT
70:   IF NO.PMTS=0 THEN PRINT "####### No prompts found for this File ######" ; RETURN
      LINE.ITEMS=''
      Q=''
      FOR PMT=1 TO NO.PMTS
         IF D.D(PMT)<1,RV$PRO.FLD.NAME> = "LINE.ITEMS" THEN LINE.ITEMS=PMT
      NEXT PMT
      IF START.SCR(1)='' THEN START.SCR(1)=1
      IF END.SCR(1)='' THEN END.SCR(1)=NO.PMTS
      IF LINE.ITEMS THEN
         END.SCR(1)=LINE.ITEMS
         START.SCR(2)=LINE.ITEMS+1
         END.SCR(2)=NO.PMTS
      END
*
* GENERATE MASK FOR SCREEN
*
      CVS=''                             ; * WHETHER OR NOT THERE ARE ANY CONVERSION
      IF NOT(LINE.ITEMS) THEN LINE.ITEMS=NO.PMTS
      IF LINE.ITEMS>19 THEN MAX.PMT=19 ELSE MAX.PMT=LINE.ITEMS         ; * FOR TWO COLUMN SCREEN
      MASK=''
      FOR I=1 TO NO.PMTS
         Q=D.D(I)<1,RV$PRO.FLD.FORMAT>
         IF Q = '' THEN
            X = 10
         END ELSE
            X=MATCHFIELD(Q,'0A0N0X',2)
         END
         IF END.SCR(1) > 19 THEN
            IF X > 24 THEN X=24
         END ELSE IF X > 63 THEN X = 63
         LFMT(I)='L#':X
         RFMT(I)='R#':X
         IF X=0 THEN
            LFMT(I)=0
            RFMT(I)=0
         END
         CV(I)=D.D(I)<1,RV$PRO.FLD.CONVERSION>
         IF CV(I) NE '' THEN CVS=1
      NEXT I
      LFMT1='L#60'
*
*
*
*
* SET UP TABS FOR LINE ITEMS SCREEN AND SET JUSTIFICATIONS
      FOR I=END.SCR(1)+1 TO NO.PMTS
         IF INDEX(D.D(I)<1,RV$PRO.FLD.FORMAT>,'L',1) THEN RFMT(I)=LFMT(I)
         IF INDEX(D.D(I)<1,RV$PRO.FLD.FORMAT>,'T',1) THEN RFMT(I)=LFMT(I)
      NEXT I
*
!
*
* GET ITEM-WISE INPUT
*
      LINE.NO=1
100:  PRINT @(-1):
      FILED=''                           ; * FLAG TO INDICATE PROCESS WAS TERMINATED WITH SHORT-CUT FILING
      IF BATCH.AMC THEN PRINT 'Batch:':BATCH.NO:'  ':
      PRINT " ":TITLE<1>[1,31]:"  REVISE.1  ":
      GOSUB PRINT.TIMEDATE
      PRINT ; PRINT MASK
      DELETE.ID=""
      MAT INP=''
*
* GET KEY
*
      PMT =1                             ; * KEY
      SCR=1
110:  READNEXT Q ELSE GO ASK.
      IF VERIFY(PMT)#"" THEN             ; * Verify the data      ;* 003
         GOSUB 600                       ; * if required.         ;* 003
         IF REPAINT THEN INP(PMT)=Q ; GOSUB 130    ; * 003
         IF Q='' THEN GO 110             ; * 003
      END                                ; * 003
      INP(1)=Q
      READING.NEXT=1
      GO 120
ASK.: GOSUB PROMPTER ; IF NOT(OK) THEN GO 110
      READING.NEXT=''
      INPUT.LEN = LEN(Q)
      IF INPUT.LEN = 0 THEN INPUT.LEN = 1
      IF UPCASE(Q) = RV$CMD.END OR UPCASE(Q) = RV$CMD.QUIT[1,INPUT.LEN] THEN GO 9900       ; * WRAP UP AND QUIT
      IF Q THEN IF NOT(INDEX(STD.RESP0,@FM:Q:@FM,1)) THEN GO AROUND.STD          ; *006
      IF Q= RV$CMD.HELP THEN GOSUB 9000 ; GO 110
      IF Q= RV$CMD.SKIP THEN
         IF REQUIRED THEN GO 110
         Q=''
         GO AROUND.STD
      END
      IF UPCASE(Q)= RV$CMD.TOP THEN PROCESS='' ; GO 10
      IF Q= RV$CMD.PROMPT THEN GO 110
      IF Q= RV$CMD.REDRAW THEN START.PMT=1 ; END.PMT=END.SCR(1) ; GOSUB 130 ; GO 110
      IF Q= RV$CMD.EXTENDED.HELP THEN GOSUB 9200 ; GO 100
AROUND.STD:
      IF Q='' THEN
         IF NEXT.AVAILABLE THEN GO 111   ; * THE IN-SENTENCE OPTION
         IF PROCESS='' OR PROCESS='ENTER.DICT' THEN GO 9900   ; * DIRECT DICTIONARY PROMPTING
         IF NOT(NEXT.AVAILABLE) THEN RETURN
* ASSIGN NEXT AVAILABLE
111:     READU Q FROM DICT.DATA.FILE, '&NEXT.AVAILABLE&' ELSE Q=@AM:1
         Q=Q<2>
         IF NOT(NUM(Q)) OR Q='' THEN Q=1
         WRITE 'X':@AM:Q+1 ON DICT.DATA.FILE, '&NEXT.AVAILABLE&'
         FILL.C=D.D(PMT)<1,RV$PRO.FLD.FILL.CODE>
         IF FILL.C#"" THEN Q=FMT(Q,RFMT(PMT):FILL.C)
         READ X FROM DATA.FILE, Q ELSE GO 112
         GO 111
112:
         USING.NEXT.AVAILABLE=Q
         PRINT "Next available ":D.D(PMT)<1,RV$PRO.FLD.DISPLAY>:" is ":Q:" and is also a ":
      END ELSE USING.NEXT.AVAILABLE=''
      FILL.C=D.D(PMT)<1,RV$PRO.FLD.FILL.CODE>
      IF FILL.C#"" THEN Q=FMT(Q,RFMT(PMT):FILL.C)
      IF VERIFY(PMT)#"" THEN
         GOSUB 600
         IF REPAINT THEN INP(PMT)=Q ; GOSUB 130
         IF Q='' THEN GO 110
      END
      INP(PMT)=Q
      IF CV(PMT)#"" THEN Q=OCONV(Q,CV(PMT)) ; REPAINT=1
120:
      LINE.NO=1
      SCR=1
      UpdateType = ''
125:  READU ITEM FROM DATA.FILE, INP(1) LOCKED
         PRINT "Sorry, but Record ":INP(1):" is currently locked for use by User number ":STATUS():"."
         IF READING.NEXT THEN
            PRINT "Press <RETURN> to try again or enter  QUIT  to skip it.":
            INPUT Q
            IF Q[1,1]='Q' THEN GO 110
            GO 125
         END ELSE GO ASK.
      END ELSE
         DF.ERROR = STATUS()
         IF DF.ERROR = 1 OR DF.ERROR = 2 THEN
            CALL *UVPRINTMSG(970012,INP(1))
            PRINT "Press <RETURN> to continue":
            INPUT Q
            GO 100
         END
         ELSE IF DF.ERROR = 3 THEN
            CALL *UVPRINTMSG(47007,INP(1))
            PRINT "Press <RETURN> to continue":
            INPUT Q
            GO 100
         END
         ELSE IF DF.ERROR = 4 THEN
            * Warning message already issued - no need to repeat ourselves
            * CALL *UVPRINTMSG(47006,INP(1))
            PRINT "Press <RETURN> to continue":
            INPUT Q
            GO 100
         END
         IF READING.NEXT THEN PRINT D.D(PMT)<1,RV$PRO.FLD.DISPLAY>:'=':FMT(OCONV(Q,CV(PMT)),LFMT(PMT))
         START.PMT=2
         IF LINE.ITEMS EQ NO.PMTS THEN END.PMT=END.SCR(1) ELSE END.PMT=LINE.ITEMS-1
         GOSUB 1000
         IF D.D(PMT)<1,RV$PRO.FLD.VERIFIELD> THEN CALL !SLEEP$(2500)
         IF Q= RV$CMD.PROMPT OR UPCASE(Q)= RV$CMD.TOP THEN
            IF USING.NEXT.AVAILABLE THEN GOSUB RESET.NEXT.AVAILABLE
            RELEASE DATA.FILE, INP(1)
            GO 100
         END
         LAST.SCREEN = INMAT(START.SCR)<1,1>
         FOR SCR=2 TO LAST.SCREEN
            IF START.SCR(SCR) THEN GOSUB 700
            IF FILED THEN GO 100
            IF UPCASE(Q) = RV$CMD.TOP OR UPCASE(LINE.NO) = RV$CMD.TOP THEN SCR=INMAT(START.SCR)<1,1>
         NEXT SCR
         START.PMT=1
         END.PMT=END.SCR(1)
         SCR=1
         GOSUB 130
         GOSUB 500
         IF UPCASE(PMT) = RV$CMD.TOP THEN
            IF USING.NEXT.AVAILABLE THEN GOSUB RESET.NEXT.AVAILABLE
            RELEASE DATA.FILE, INP(1)
         END
         GO 100
      END
*                                                                          ;*009
*      Check to see if we arw working with a dictionary, and the type of   ;*009
*       record we have selected, ie. if an i-type or d-type.               ;*009
*                                                                          ;*009
      ORIGINAL.TYPE = ITEM<2>            ; * Store the original away;*009
      IF DICT THEN
         IF ITEM<1>[1,1] ='I' THEN ITYPE = 1
         IF ITEM<1>[1,1] ='D' THEN DTYPE = 1
      END

*
* EXTRACT ATTRIBUTES
*
* Give the user time to see any output from a VERIFEILD command.         ;* 003
*                                                                        ;* 003
      IF D.D(PMT)<1,RV$PRO.FLD.VERIFIELD> THEN CALL !SLEEP$(2500)      ; * 003
*
      OLD(1)=INP(1)
      FOR I=2 TO NO.PMTS
         INP(I)=ITEM<D.D(I)<1,RV$PRO.FLD.LOCATION>>
         OLD(I)=INP(I)
      NEXT I
      START.PMT=1
      END.PMT=END.SCR(1)
      SCR=1
      GOSUB 130
      GOSUB 500
      GO 100
*
*
* DISPLAY ITEM ON SCREEN
*
130:  PRINT @(-1):
      IF BATCH.NO THEN PRINT "Batch:":BATCH.NO:
      PRINT TITLE[1,31]:" -Screen ":SCR:"-":PROCESS.ITEM<RV$PRO.SCREEN.HEADING,SCR>[1,20]:" ":
      GOSUB PRINT.TIMEDATE
      PRINT
      IF START.PMT GT END.SCR(1) THEN
         X=INP(1)
         IF CV(1) # "" THEN X=OCONV(X,CV(1))
         PRINT D.D(1)<1,RV$PRO.FLD.NAME>:"==>>":FMT(X,LFMT(1)):"  Line==>> ":LINE.NO
      END
      FOR I=START.PMT TO END.PMT
         X=INP(I)<1,LINE.NO>
         IF CV(I)#"" THEN X=OCONV(X,CV(I))
         PRINT FMT(I,'2L'):' ':FMT(D.D(I)<1,RV$PRO.FLD.NAME>,'L#10'):" ":
         IF LFMT(I) NE 0 THEN PRINT X ELSE PRINT
      NEXT I
      IF SCR=1 THEN IF END.PMT EQ END.SCR(1) THEN
         PRINT
         I=1
         LOOP X=PROCESS.ITEM<RV$PRO.SCREEN.HEADING,I> UNTIL X='' DO
            PRINT "S":I:" == ":X
            PRINT CHAR(13):
            I+=1
         REPEAT
         PRINT
      END
      REPAINT=''
      RETURN
*
500:* MODIFY RECORD OR LINE ITEM ROUTINE
*
      IF FROM.SC2 THEN IF START.PMT=END.PMT THEN
* ONLY ONE FIELD TO DEAL WITH
         IF Q= RV$CMD.PROMPT THEN RETURN           ; * DIDN'T WANT TO CHANGE IT AFTER ALL
         PMT=END.PMT
         GO 510
      END
      PRINT CHANGE<2>:"=":
      INPUT PMT
      IF PMT= RV$CMD.SKIP OR UPCASE(PMT) = RV$CMD.FILE THEN
         GOSUB UpdateDatabase
         IF NOT(UpdateSuccess) THEN GO 500
         RETURN
      END
      INPUT.LEN = LEN(PMT)
      IF INPUT.LEN = 0 THEN INPUT.LEN = 1
      IF UPCASE(PMT) = RV$CMD.QUIT[1,INPUT.LEN] THEN
         IF NOT(READING.NEXT) THEN
            PRINT @SYS.BELL:'There is no SELECT list active'
            GO 500
         END
         RELEASE DATA.FILE, INP(1)
         CLEARSELECT
         RETURN TO 100
      END
      IF INDEX(STD.RESP,@FM:PMT:@FM,1) THEN GO 550           ; *006
      IF UPCASE(PMT) MATCHES "'S'0N" THEN
         SCR=PMT[2,99]
         IF SCR > INMAT(START.SCR)<1,1> THEN
            PRINT "Invalid Screen number."
            GO 500
         END
         IF NOT(END.SCR(SCR)) THEN
* that screen is not defined in this process.
            CALL *UVPRINTMSG(001588,"")
            GO 500
         END
         IF SCR=1 THEN GO 500 ELSE GO 508
      END
505:  IF NOT(NUM(PMT)) THEN GO 506
      IF PMT<START.PMT OR PMT>END.PMT THEN
* invalid prompt number
506:     CALL *UVPRINTMSG(001583,START.PMT:@FM:END.PMT)
         GO 500
      END
      IF NOT(FROM.SC2) THEN
         SCR=D.D(PMT)<1,RV$PRO.FLD.SCREEN.NO>
         IF SCR='' THEN SCR=1
         IF NOT(NUM(SCR)) THEN SCR=1
         IF SCR LT 1 THEN SCR=1
508:     IF SCR GT 1 THEN
            GOSUB 700 ; IF FILED THEN RETURN
            START.PMT=1
            END.PMT=END.SCR(1)
            SCR=1
            LINE.NO=1
            GOSUB 130
            GO 500
         END
      END
      IF NO.PMTS NE LINE.ITEMS THEN IF PMT EQ LINE.ITEMS THEN
         SCR=2
         GOSUB 700 ; IF FILED THEN RETURN
         START.PMT=1
         END.PMT=LINE.ITEMS
         LINE.NO=1
         GOSUB 130
         GO 500
      END
      IF D.D(PMT)<1,RV$PRO.FLD.DISPLAYONLY> THEN
* This field is displayed for your reference only
         CALL *UVPRINTMSG(001586,"")
         GO 500
      END
*
!
*
!
* INSERT PROMPT SPECIFIC LOGIC HERE
!
*
!
*
510:
      GOSUB PROMPTER ; IF NOT(OK) THEN GO 510
      IF Q # "" THEN
         IF INDEX(STD.RESP0,@FM:Q:@FM,1) THEN GO 560         ; *006
         IF Q='"' THEN
            IF FROM.SC2 THEN
               IF LINE.NO EQ 1 THEN
* not valid on first screen
                  CALL *UVPRINTMSG(001577,"")
                  GO 510                 ; *012
               END                       ; *012
               Q=INP(PMT)<1,LINE.NO-1>
               GO 540
            END ELSE
* not valid on first screen
               CALL *UVPRINTMSG(001577,"")
               GO 510
            END
         END
515:     IF FROM.SC2 THEN
            IF PMT=START.PMT THEN
               IF Q='##' THEN
                  FOR I=START.PMT TO END.PMT
                     INP(I)=DELETE(INP(I),1,LINE.NO,0)
                  NEXT I
                  ALL.LINES-=1
                  RETURN
               END
               IF Q[1,1]='>' THEN
                  IF Q='>' THEN
* inserting the following information at line
                     CALL *UVPRINTMSG(001579,LINE.NO)
                     FOR I=START.PMT TO END.PMT
                        INP(I)=INSERT(INP(I),1,LINE.NO,0,'')
                     NEXT I
                     GOSUB 1000
                     RETURN
                  END
                  LINE.X=FIELD(Q,'#',2)
                  IF NOT(NUM(LINE.X)) THEN PRINT "WHAZZAT?" ; GO 510
                  IF LINE.X LE 0 OR LINE.X GT ALL.LINES THEN
* line number not defined
                     CALL *UVPRINTMSG(001580,LINE.X)
                     GO 510
                  END
                  FOR I=START.PMT TO END.PMT
                     INP(I)=INSERT(INP(I),1,LINE.NO,0,INP(I)<1,LINE.X>)
                  NEXT I
                  ALL.LINES+=1
                  Q = INP(START.PMT)<1,LINE.X+1>
                  GO 545
               END
            END
         END
         FILL.C=D.D(PMT)<1,RV$PRO.FLD.FILL.CODE>
         IF FILL.C#"" THEN Q=FMT(Q,RFMT(PMT):FILL.C)
         IF VERIFY(PMT)#"" THEN
            GOSUB 600
            IF REPAINT THEN INP(PMT)<1,LINE.NO> = Q ; GOSUB 130
            IF Q='' THEN GO 510
         END
         IF NOT(UpdateType) THEN UpdateType = UpdateExisting
         IF PMT=1 THEN
            GOSUB 650
            IF DELETE.ID='' THEN DELETE.ID=INP(1)  ; * DELETE ON KEY CHANGE
         END
      END
*
!
*
!
* INSERT RESPONSE SPECIFIC LOGIC HERE
!
*
!
*
540:
      IF SCR = 1 THEN
         DMdelimiter = @FM
      END ELSE
         DMdelimiter = @VM
      END
      GOSUB ReplaceData
545:
      IF NOT(UpdateType) THEN UpdateType = UpdateExisting
      IF Q NE INP(PMT)<1,LINE.NO> THEN
         PRINT "REPLACE error after 540 -- ":Q:" became ":INP(PMT)<1,LINE.NO>:"."
      END
      IF CV(PMT)#"" THEN Q=OCONV(Q,CV(PMT)) ; REPAINT=1
      IF FROM.SC2 THEN IF START.PMT=END.PMT THEN REPAINT='' ; RETURN   ; * ONLY ONE FIELD
      GO 500
*
550:* STANDARD EXCEPTIONS
*
      IF PMT= RV$CMD.HELP THEN PRINT CHANGE<10> ; GO 500
*---- PCC Added release.
      IF UPCASE(PMT) = RV$CMD.TOP THEN RELEASE DATA.FILE, INP(1) ; RETURN
      IF PMT='' THEN
         IF REPAINT THEN GOSUB 130 ; GO 500
*------- PCC Added release.
         IF FROM.SC2 THEN RELEASE DATA.FILE, INP(1) ; RETURN
         GOSUB UpdateDatabase
         IF NOT(UpdateSuccess) THEN GO 500
         RETURN
      END
      IF PMT= RV$CMD.PROMPT THEN GO 500
      IF PMT= RV$CMD.REDRAW THEN GOSUB 130 ; GO 500
      IF PMT= RV$CMD.EXTENDED.HELP THEN PMT=0 ; GOSUB 9200 ; GOSUB 130 ; GO 500
      IF UPCASE(PMT) = RV$CMD.DELETE THEN
         IF UpdateType = UpdateNew THEN RELEASE DATA.FILE, INP(1) ; RETURN
         IF DELETE.ID#'' THEN INP(1)=DELETE.ID
         IF AUDIT.FILE NE '' THEN
            READ AUDIT.ITEM FROM DATA.FILE,INP(1) ELSE AUDIT.ITEM=''
            A.KEY=FNAME:"@":OLD(1):"@":DATE():"@":TIME():"@DELETED"
            WRITE AUDIT.ITEM ON AF,A.KEY
         END
         DELETE DATA.FILE,INP(1)
         KEY=OLD(1)
         FOR PMT=1 TO NO.PMTS
            IF VERIFY(PMT)<1,3> THEN GOSUB DeleteXReference
         NEXT PMT
         RETURN
      END
      IF PMT= RV$CMD.PROMPT THEN GO 500
      IF PMT= RV$CMD.SKIP THEN GO 500
      GO 505                             ; * INPUT OK, JUST LOOKED LIKE AN EXCEPTION (T,O,P,ETC.)
*
560:* MORE STANDARD EXCEPTIONS
*
      IF Q= RV$CMD.HELP THEN GOSUB 9000 ; GO 510
      IF UPCASE(Q) = RV$CMD.TOP THEN RETURN
      IF UPCASE(Q) = RV$CMD.DELETE THEN PRINT @SYS.BELL:"Not valid here." ; GO 510
      IF Q= RV$CMD.SKIP THEN GO 500
      IF Q= RV$CMD.PROMPT THEN GO 500    ; * NOCHANGE
      IF Q= RV$CMD.REDRAW THEN GOSUB 130 ; GO 510
      IF Q= RV$CMD.EXTENDED.HELP THEN GOSUB 9200 ; GOSUB 130 ; GO 510
      GO 515                             ; * INPUT OK, JUST LOOKED LIKE AN EXCEPTION (T,O,P,ETC.)
600:* FILE VERIFICATION SUBROUTINE
*
* Remember the following:                                               ;* 003
*                                                                       ;* 003
*       VERI.AMC = 0        The key to the file is the verify.field     ;* 003
*       VERI.AMC > 1        A non-key field is the verify.field         ;* 003
*       VERI.AMC = ''       There is no verify.field                    ;* 003
*
      REPAINT=''
      VERI.AMC=D.D(PMT)<1,RV$PRO.FLD.VERIFIELD>
      FILE.NO=VERIFY(PMT)<1,1>
      IF FILE.NO='' THEN RETURN
      READ X FROM VERIFILE(FILE.NO), Q ELSE
         IF PMT=1 THEN IF VERI.AMC='' THEN RETURN  ; * Changed NOT(VERI.AMC) *003
         FILE.NO=VERIFY(PMT)<1,2>
         IF FILE.NO THEN
            START.PMT=START.SCR(SCR)
            END.PMT=END.SCR(SCR)
            READ X FROM VERIFILE(FILE.NO), Q ELSE GO 620
            FMC=VERI.AMC
            IF FMC='' THEN FMC=1
            IF COUNT(X<1>,@VM) = 0 THEN Q = X<1> ; PRINT Q ; RETURN    ; *005
            PRINT @(-1):" Cross Reference Display "
            PRINT "ITEM  ":D.D(PMT)<1,RV$PRO.FLD.DISPLAY>:"  ":FMT("DESC",LFMT1)
            LC=1
            FILE.NO=VERIFY(PMT)<1,1>
            I=1
            LOOP Q=X<1,I> UNTIL Q='' DO
               READ K FROM VERIFILE(FILE.NO),Q ELSE
                  K="not found on Master File."
                  GO 615
               END
               K=K<FMC>
615:           PRINT FMT(LC,"R#3"):'==>':FMT(Q,LFMT(PMT)):'  ':FMT(K,LFMT1)
               PRINT
               LC=LC+1
               IF MOD(LC,11) = 0 THEN
617:              PRINT "Which Item would you like? (<RETURN> to see next page, END  to stop display)":
                  INPUT K
                  IF K='' THEN
                     PRINT @(-1):" Cross Reference Display"
                     PRINT "ITEM  ":D.D(PMT)<1,RV$PRO.FLD.DISPLAY>:"  ":FMT("DESC",LFMT1)
                     PRINT
                     GO 618
                  END
                  IF UPCASE(K) = RV$CMD.END THEN GOSUB 130 ; Q='' ; RETURN
                  IF NUM(K) THEN
                     IF K LE 0 OR K GT LC THEN PRINT "That number is not displayed." ; GO 617
                     Q=X<1,K>
                     REPAINT=1
                     RETURN
                  END
                  PRINT @SYS.BELL:"Enter the number of the line you wish, a <RETURN> or END."
                  GO 617
               END
618:           I=I+1
            REPEAT
            IF I#1 THEN
619:           PRINT "Which Item would you like ":
               INPUT K
               IF NUM(K) THEN
                  IF K GT 0 AND K LE LC THEN
                     Q=X<1,K>
                     REPAINT=1
                     RETURN
                  END
               END
               IF K='?' THEN
                  PRINT "Enter the Item number of the ":D.D(PMT)<1,RV$PRO.FLD.DISPLAY>:" you wish or <RETURN> for previous prompt."          ; *005
                  GO 619
               END
               Q=''
               GOSUB 130                 ; * Repaint and reprompt                          ;*005
               RETURN
            END
         END
620:     PRINT @SYS.BELL:Q:" not found on ":D.D(PMT)<1,RV$PRO.FLD.VERIFILE>:"."
         Q=''
         RETURN
      END
      IF PMT=1 THEN IF VERI.AMC = '' THEN          ; * Changed NOT(VER.AMC) to ''. ;* 003
         PRINT @SYS.BELL:Q:" already present on ":D.D(PMT)<1,RV$PRO.FLD.VERIFILE>:"." ; Q='' ; RETURN
      END
*
* Only want to output the contents of the verify.field if it is not the   ;* 003
* key to the verify.file (i.e. VERI.AMC > 0).                             ;* 003
*
      IF VERI.AMC THEN PRINT X<VERI.AMC>
      RETURN
650:* CHECK FOR PRE-EXISTING ITEM ON ID CHANGE
      READ X FROM DATA.FILE, Q ELSE GO 655
      PRINT @SYS.BELL:"WARNING: ":Q:" already exists on ":FNAME:"."
655:*
      RETURN
700:* LINE ITEMS CONTROL ROUTINE
      FROM.SC2=1
      START.PMT=START.SCR(SCR)
      END.PMT=END.SCR(SCR)
      MIN.LINE.NO=1
      ADD.FLAG=''
      INSERT.FLAG=''
      IF ISNULL(INP(START.PMT)) OR INP(START.PMT) = @null.str THEN
         ALL.LINES=1
      END ELSE
         ALL.LINES=COUNT(INP(START.PMT),@VM)+1
         IF ALL.LINES EQ 1 THEN
            ALL.LINES=0
            ADD.FLAG=1
            FOR PMT = START.PMT TO END.PMT
               IF LEN(INP(PMT)<1>) > 0 THEN
                  ALL.LINES=1
                  ADD.FLAG=0
                  GO 705
               END
            NEXT PMT
         END      
      END
705:  PRINT @(-1):
      PRINT TITLE[1,31]:" -Screen ":SCR:"-":PROCESS.ITEM<RV$PRO.SCREEN.HEADING,SCR>[1,20]:" ":
      GOSUB PRINT.TIMEDATE
      PRINT
      Q=INP(1)
      IF CV(1) # "" THEN Q=OCONV(Q,CV(1))
      PRINT D.D(1)<1,RV$PRO.FLD.NAME>:'==> ':Q
      PRINT "No. ":
      FOR I=START.PMT TO END.PMT
         PRINT FMT(D.D(I)<1,RV$PRO.FLD.NAME>,RFMT(I)[3,5]:'.':RFMT(I)):" ":
      NEXT I
      PRINT
      FOR NO.LINES=MIN.LINE.NO TO ALL.LINES
         PRINT FMT(NO.LINES,'3R'):" ":
         FOR I=START.PMT TO END.PMT
            Q=INP(I)<1,NO.LINES>
            IF CV(I)#"" THEN Q=OCONV(Q,CV(I)) ; REPAINT=1
            IF I=END.PMT THEN IF Q='' THEN GO 710
* fix for formatting sql null correctly
            IF ISNULL(Q) THEN
               PRINT FMT(" ",RFMT(I)):" ":
            END ELSE
               PRINT FMT(Q,RFMT(I)):" ":
            END
710:     NEXT I
         PRINT
         IF NO.LINES-MIN.LINE.NO >= MAX.LINES THEN MAX.LINE.NO= NO.LINES ; GO 720
      NEXT NO.LINES
      NO.LINES=ALL.LINES+1
      MAX.LINE.NO=MIN.LINE.NO+MAX.LINES
      IF NO.LINES LE MAX.LINE.NO+1 THEN PRINT FMT(NO.LINES,'3R')
      IF INSERT.FLAG THEN LINE.NO=INSERT.FLAG ; INSERT.FLAG='' ; GO 740
      IF ADD.FLAG THEN LINE.NO=NO.LINES ; GO 740
720:
      PRINT
      CALL *UVPRINTMSG(001581,"")        ; * change which line number
      INPUT LINE.NO
      IF LINE.NO='' THEN IF MAX.LINE.NO LE ALL.LINES THEN MIN.LINE.NO=MAX.LINE.NO+1 ; GO 705
      IF UPCASE(LINE.NO) = RV$CMD.TOP OR LINE.NO='' THEN FROM.SC2='' ; LINE.NO=1 ; RETURN
      IF LINE.NO= RV$CMD.SKIP OR UPCASE(LINE.NO) = 'FILE' THEN
         GOSUB UpdateDatabase
         IF NOT(UpdateSuccess) THEN GOTO 720
         FROM.SC2=''
         LINE.NO=1
         RETURN
      END
      IF LINE.NO= RV$CMD.HELP THEN
         PRINT "Enter the number of the line you wish to change; <CR>/<NL> = none or done; ?? for HELP."
         GO 720
      END
      IF LINE.NO= RV$CMD.REDRAW THEN GO 705
      IF LINE.NO= RV$CMD.EXTENDED.HELP THEN PMT=NO.PMTS+1 ; GOSUB 9200 ; GO 705
      IF LINE.NO= RV$CMD.PROMPT THEN GO 720
740:  IF LINE.NO = MAX.LINE.NO + 1 THEN MIN.LINE.NO=LINE.NO ; GO 705
      IF LINE.NO<MIN.LINE.NO OR LINE.NO>MAX.LINE.NO THEN
         PRINT @SYS.BELL:"Just ":MIN.LINE.NO:" - ":MAX.LINE.NO:" . Try again."
         GO 720
      END
      IF NOT(UpdateType) THEN UpdateType = UpdateExisting
      IF ALL.LINES LT LINE.NO THEN ADD.FLAG=1 ELSE ADD.FLAG=''
      IF ADD.FLAG THEN                   ; * ADDING A NEW LINE
         GOSUB 1000
      END ELSE
         GOSUB 130                       ; * REPAINT SCREEN IN VERTICAL FORMAT
         GOSUB 500                       ; * MODIFY LINE
         IF D.D(PMT)<1,RV$PRO.FLD.VERIFIELD> THEN CALL !SLEEP$(2500)
      END
      IF FILED THEN RETURN
      IF UPCASE(Q) = RV$CMD.TOP THEN ADD.FLAG=''
      IF ADD.FLAG THEN IF START.PMT=END.PMT THEN
         LINE.NO+=1
         NO.LINES+=1
         GO 740
      END
      GO 705
1000:* NEW RECORD OR LINE ITEM ROUTINE
      IF NOT(FROM.SC2) THEN
         CALL *UVPRINTMSG(001606,"")     ; * new record
         UpdateType = UpdateNew
         ST.PMT=2
      END ELSE ST.PMT=START.PMT
      QUIT=''
      FOR PMT=ST.PMT TO END.PMT
         IF D.D(PMT)<1,RV$PRO.FLD.DISPLAYONLY> THEN Q='' ; GO 1040     ; * NO SHOW MAINTENANCE
         QUIT+=1
         IF LAST.IN(PMT)#"" THEN
            IF LAST.INPUT(PMT) # "" THEN
               IF FROM.SC2 THEN
                  IF LINE.NO NE 1 THEN Q=LAST.INPUT(PMT)<1,LINE.NO-1> ELSE Q=LAST.INPUT(PMT)
               END ELSE
                  Q=LAST.INPUT(PMT)
               END
               PRINT D.D(PMT)<1,RV$PRO.FLD.LOCATION>:"= ":Q  ; * DISPLAY AUTO-DUPLICATED VALUES
               GO 1040
            END
         END
1010:
         GOSUB PROMPTER ; IF NOT(OK) THEN GO 1010
         IF Q#"" THEN
            IF INDEX(STD.RESP0,@FM:Q:@FM,1) THEN GO 1050     ; *006
            IF Q='"' THEN
               IF FROM.SC2 THEN
                  IF LINE.NO EQ 1 THEN PRINT "Nothing to repeat." ; GO 1010
                  Q=INP(PMT)<1,LINE.NO-1>
                  PRINT OCONV(Q,CV(PMT))
                  GO 1040
               END ELSE
                  PRINT "Not valid on first Screen."
                  GO 1010
               END
            END
            IF Q='##' AND FROM.SC2 THEN
               PRINT @SYS.BELL:"You are trying to delete before you enter. Try again."
               GO 1010
            END
            IF Q[1,1]='>' AND FROM.SC2 THEN
               LINE.X=FIELD(Q,'#',2)
               IF NOT(NUM(LINE.X)) THEN PRINT "WHAZZAT?" ; GO 1010
               IF LINE.X LE 0 OR LINE.X GT ALL.LINES THEN
                  PRINT "Line number ":LINE.X:" has not been defined."
                  GO 1010
               END
               FOR I=START.PMT TO END.PMT
                  INP(I)=INSERT(INP(I),1,LINE.NO,0,INP(I)<1,LINE.X>)
               NEXT I
               GOSUB 130
               ALL.LINES+=1
               GO 1000
            END
1015:*
            FILL.C=D.D(PMT)<1,RV$PRO.FLD.FILL.CODE>
            IF FILL.C#"" THEN Q=FMT(Q,RFMT(PMT):FILL.C)
            IF VERIFY(PMT)#"" THEN
               GOSUB 600
               IF REPAINT THEN
                  INP(PMT)<1,LINE.NO> = Q
                  J=END.PMT
                  END.PMT=PMT
                  IF Q='' THEN END.PMT-=1
                  GOSUB 130
                  END.PMT=J
               END
               IF Q='' THEN GO 1010
               IF D.D(PMT)<1,RV$PRO.FLD.VERIFIELD> THEN      ; * Check if the    ;* 003
                  CALL !SLEEP$(2500)     ; * verifield data  ;* 003
               END                       ; * needs displayed.;* 003
            END
         END ELSE
            IF QUIT=1 THEN IF FROM.SC2 THEN Q = RV$CMD.TOP ; RETURN
            IF D.D(PMT)<1,RV$PRO.FLD.REQUIRED> = RV$PRO.VAL.REQUIRED THEN
               CALL *UVPRINTMSG(001578,"")         ; * entry required
               GO 1010
            END
         END
!
* INSERT PROMPT/RESPONSE SPECIFIC LOGIC HERE
!
1040:    
         DMdelimiter = @VM
         GOSUB ReplaceData
      NEXT PMT
1045: IF FROM.SC2 THEN ALL.LINES+=1
      RETURN
1050:* STANDARD EXCEPTIONS
      IF Q= RV$CMD.HELP THEN GOSUB 9000 ; GO 1010
      IF UPCASE(Q)= RV$CMD.TOP THEN RETURN
      IF Q= RV$CMD.PROMPT THEN
         PMT=PMT-1
         IF PMT<START.PMT THEN Q = RV$CMD.TOP ; RETURN
         IF PMT=1 THEN Q = RV$CMD.TOP ; RETURN
         IF D.D(PMT)<1,RV$PRO.FLD.DISPLAYONLY> THEN GO 1050  ; * DON'T BACK INTO A NO.SHOW
         CALL *UVPRINTMSG(001576,"")     ; * backing up
         GO 1010
      END
      IF Q= RV$CMD.SKIP THEN
         FOR I= PMT TO END.PMT
            IF D.D(I)<1,RV$PRO.FLD.REQUIRED>= RV$PRO.VAL.REQUIRED THEN
               PMT=I
               GO 1010
            END
         NEXT I
         GO 1045
      END
      IF Q= RV$CMD.REDRAW THEN GOSUB 130 ; GO 1010
      IF Q= RV$CMD.EXTENDED.HELP THEN GOSUB 9200 ; GOSUB 130 ; GO 1010
      IF UPCASE(Q) = RV$CMD.DELETE THEN PRINT @SYS.BELL:"Not valid here." ; GO 1010
      GO 1015                            ; * INPUT OK, JUST LOOKED LIKE AN EXCEPTION (T,O,P,ETC.)
9000:* EXPLAINAITON ROUTINE
      IF PROCESS THEN
         IF D.D(PMT)<1,RV$PRO.FLD.BRIEFHELP>='' THEN
9050:       PRINT "No explanation has been provided for this Prompt."
            RETURN
         END ELSE
            PRINT D.D(PMT)<1,RV$PRO.FLD.BRIEFHELP>
         END
      END ELSE
         READ X FROM DICT.DATA.FILE,D.D(PMT)<1,RV$PRO.FLD.BRIEFHELP> ELSE GO 9050
         X=FIELD(X<1>,' ',2,999)
         IF LEN(X) LT 1 THEN GO 9050
         PRINT X
         RETURN
      END
      RETURN
9200:* PARAGRAPH ENTRY POINT
      IF PMT=0 THEN
         Q='REVISE*CHANGE'
      END ELSE
         IF PMT=NO.PMTS+1 THEN
            Q='REVISE*CHANGEL'
         END ELSE
            Q=PROCESS:'*':D.D(PMT)<1,RV$PRO.FLD.DISPLAY>
            Q = UPCASE(Q)                ; *099
         END
      END
      IF DISC.FILE.NOT.OPEN THEN
         OPENCHECK '',REVISE.DISCUSSIONS TO DE ELSE
            OPENCHECK '','NEWACC' TO NEWACC.FILE ELSE
               PRINT "Can't open NEWACC"
               RETURN
            END
            READ NEWACC.RECORD FROM NEWACC.FILE,REVISE.DISCUSSIONS ELSE
               PRINT "Can't find ":REVISE.DISCUSSIONS
               RETURN
            END
            * --- Write the record out to the VOC.
            WRITE NEWACC.RECORD TO DEVSYS.VOC.FILE,REVISE.DISCUSSIONS
            OPENCHECK '',REVISE.DISCUSSIONS TO DE ELSE
               PRINT "The ":REVISE.DISCUSSIONS:" file cannot be found."
               PRINT "Sorry, no extended explanations."
               GO TO 9210
            END
         END
         DISC.FILE.NOT.OPEN=''
      END
      READ X FROM DE,Q ELSE PRINT "No extended discussion has been provided for this Prompt." ; GO 9210
      PRINT @(-1):"Discussion of ==>":D.D(PMT)<1,RV$PRO.FLD.DISPLAY>
      PRINT
      I=1
      LOOP REMOVE Q FROM X SETTING XMARK
         PRINT Q
         I+=1
         IF I > (@CRTHIGH - 4) THEN
            PRINT "Press <RETURN> to continue...":
            INPUT Q
            IF Q[1,1] EQ 'Q' THEN RETURN
            PRINT @(-1):
            I=0
         END
      WHILE XMARK
      REPEAT
9210: PRINT
      PRINT "Press <RETURN>/<NEW LINE> to continue":
      INPUT Q
      RETURN
***********************************************************************
UpdateDatabase:
      Q = ''
      UpdateSuccess = TRUE
      IF DELETE.ID NE "" AND DELETE.ID # INP(1) THEN
         READU DF.RECORD FROM DATA.FILE, INP(1)
         ELSE
            DF.ERROR = STATUS()
            IF DF.ERROR = 1 OR DF.ERROR = 2 THEN
               CALL *UVPRINTMSG(970012,INP(1))
               UpdateSuccess = FALSE
               RETURN
            END
            ELSE IF DF.ERROR = 3 THEN
               CALL *UVPRINTMSG(47007,INP(1))
               UpdateSuccess = FALSE
               RETURN
            END
            ELSE IF DF.ERROR = 4 THEN
               * Warning message already issued - no need to repeat ourselves
               * CALL *UVPRINTMSG(47006,INP(1))
               UpdateSuccess = FALSE
               RETURN
            END
         END
      END
      FILED=1
      IF NOT(UpdateType) THEN RELEASE DATA.FILE, INP(1) ; RETURN

      * A call to SQLINTCHK is made with the RECORD that is going to
      * be written so that we can determine if this write is going
      * to pass integrity constraints before other files are updated
      * therefore alleviating the need to worry about backing out any
      * changes.

      SQLcheck = ITEM
      ProcessFileFlag = FALSE

      IF UpdateType = UpdateNew THEN
         SQLcheck = ''
         IF BATCH.AMC THEN
            IF NOT(BATCH.NO) THEN
               READU PROCESS.ITEM FROM PROCESS.FILE,PROCESS ELSE
                  RELEASE PROCESS.FILE,PROCESS
                  PRINT "This Process Item has disappeared - ABORT!"
                  @SYSTEM.SET = -1
                  GO 9920
               END
               ProcessFileFlag = TRUE
               SaveBATCH.NO = BATCH.NO
               BATCH.NO=PROCESS.ITEM<RV$PRO.BATCH.NO>
               IF BATCH.NO='' THEN BATCH.NO=1
               PROCESS.ITEM<RV$PRO.BATCH.NO> = BATCH.NO+1
               WRITE PROCESS.ITEM ON PROCESS.FILE, PROCESS
            END
            SQLcheck<BATCH.AMC> = BATCH.NO
         END
         IF ENTRY.DATE.AMC THEN SQLcheck<ENTRY.DATE.AMC> = DATE()
      END
      FOR PMT = 2 TO NO.PMTS
         AMC = D.D(PMT)<1,RV$PRO.FLD.LOCATION>
         SQLcheck<AMC> = INP(PMT)
      NEXT PMT
      IF DTYPE OR ITYPE THEN
         TempRec = SQLcheck
         GOSUB CLEAR.OPCODES
         SQLcheck = TempRec
      END
      IO.VAR = 2
      CALL @SQLINTCHK(SQLcheck,DATA.FILE,INP(1),UpdateFilename,IO.VAR)
      IF IO.VAR<1> THEN
         UpdateSuccess = FALSE
         FILED = ""
         SQLcheck = ""
         IF ProcessFileFlag THEN
            RELEASE PROCESS.FILE, PROCESS
            BATCH.NO = SaveBATCH.NO
         END
         RETURN
      END ELSE
         SQLcheck = ""
         IF ProcessFileFlag THEN
            PROCESS.ITEM<RV$PRO.BATCH.NO> = BATCH.NO + 1
            WRITE PROCESS.ITEM ON PROCESS.FILE, PROCESS
         END
         IF BATCH.AMC THEN ITEM<BATCH.AMC> = SQLcheck<BATCH.AMC>
         IF ENTRY.DATE.AMC THEN ITEM<ENTRY.DATE.AMC> = SQLcheck<ENTRY.DATE.AMC>
      END
      FOR PMT=1 TO NO.PMTS
         IF LAST.IN(PMT) #"" THEN LAST.INPUT(PMT)=INP(PMT)
      NEXT PMT

      IF DELETE.ID NE "" THEN
         DELETE DATA.FILE, DELETE.ID
         KEY=DELETE.ID
         FOR PMT=1 TO NO.PMTS
            IF VERIFY(PMT)<1,3> THEN GOSUB DeleteXReference
         NEXT PMT
      END

      IF UpdateType = UpdateExisting THEN
         IF BATCH.TOTAL.AMC THEN
            IF ITEM<BATCH.AMC>=BATCH.NO THEN
               IF LINE.ITEMS NE NO.PMTS THEN
                  I=1
                  LOOP Q=ITEM<LINE.ITEMS+1,I> UNTIL Q='' DO
                     BATCH.TOTAL=BATCH.TOTAL-ITEM<BATCH.TOTAL.AMC,I>
                     I=I+1
                  REPEAT
               END ELSE
                  BATCH.TOTAL=BATCH.TOTAL-ITEM<BATCH.TOTAL.AMC>
               END
            END
         END
         KEY=OLD(1)
         FOR PMT=1 TO NO.PMTS
            IF VERIFY(PMT)<1,3> THEN
               IF INP(PMT) NE OLD(PMT) THEN GOSUB DeleteXReference
            END
         NEXT PMT
         IF AUDIT.FILE NE '' THEN
            AUDIT.ITEM=''
            FOR I=2 TO NO.PMTS
               IF OLD(I) NE INP(I) THEN
                  AMC=D.D(I)<1,RV$PRO.FLD.LOCATION>
                  AUDIT.ITEM<AMC> = OLD(I)
               END
            NEXT I
            A.KEY=FNAME:"@":OLD(1):"@":DATE():"@":TIME()
            IF DELETE.ID NE "" THEN A.KEY=A.KEY:"@":INP(1)
            WRITE AUDIT.ITEM ON AF,A.KEY
         END
      END
      FOR PMT=2 TO NO.PMTS
         AMC=D.D(PMT)<1,RV$PRO.FLD.LOCATION>
         ITEM<AMC> = INP(PMT)
         IF VERIFY(PMT)<1,3> THEN IF UpdateType = UpdateNew OR DELETE.ID NE '' OR OLD(PMT) NE INP(PMT) THEN
            LOOP
               REMOVE Q FROM INP(PMT) SETTING FMC
               I = 1
               LOOP
                  J = FIELD(Q,' ',I)
               UNTIL J = '' DO
                  READU X FROM VERIFILE(VERIFY(PMT)<1,3>),J ELSE X=''
                  X = INSERT(X,1,-1,0,INP(1))
                  WRITE X ON VERIFILE(VERIFY(PMT)<1,3>),J
                  I += 1
               REPEAT
            WHILE FMC DO
            REPEAT
         END
      NEXT PMT
      IF DTYPE OR ITYPE THEN
         TempRec = ITEM
         GOSUB CLEAR.OPCODES
         ITEM = TempRec
      END
      WRITE ITEM ON DATA.FILE,INP(1) ON ERROR
         MSGID = STATUS()
         MSGARG = ""
         IF MSGID = 47006 OR MSGID = 47007 THEN
            MSGARG = INP(1)
         END
         CALL *UVPRINTMSG(MSGID,MSGARG);
         PRINT "Press <RETURN> to continue":
         INPUT Q
         UpdateSucess = FALSE
         FILED = ""
         RETURN
      END
      ELSE
         IF STATUS() = IntegrityViolation THEN
            IO.VAR = 2
            CALL @SQLINTCHK(ITEM,DATA.FILE,INP(1),UpdateFilename,IO.VAR)
            UpdateSucess = FALSE
            FILED = ""
            RETURN
         END
      END
      IF BATCH.TOTAL.AMC THEN
         IF ITEM<BATCH.AMC>=BATCH.NO THEN
            IF LINE.ITEMS NE NO.PMTS THEN
               I = 1
               LOOP
                  Q = ITEM<LINE.ITEMS+1,I>
               UNTIL Q = '' DO
                  BATCH.TOTAL += ITEM<BATCH.TOTAL.AMC,I>
                  I += 1
               REPEAT
            END ELSE
               BATCH.TOTAL += ITEM<BATCH.TOTAL.AMC>
            END
         END
      END
      RETURN
***********************************************************************
DeleteXReference:
      K = 1
      LOOP
         REMOVE L FROM OLD(PMT) SETTING FMC
         I = 1
         LOOP
            Q = FIELD(L,' ',I)
         UNTIL Q = '' DO
            READU X FROM VERIFILE(VERIFY(PMT)<1,3>), Q THEN
               J = 0
               LOOP
                  J += 1
               UNTIL X<1,J> = "" DO
                  IF X<1,J> = KEY THEN
                     X = DELETE(X,1,J,0)
                     J -= 1
                  END
               REPEAT
               IF X NE '' THEN
                  WRITE X ON VERIFILE(VERIFY(PMT)<1,3>),Q
               END ELSE
                  DELETE VERIFILE(VERIFY(PMT)<1,3>),Q
               END
            END
            I += 1
         REPEAT
         K += 1
      WHILE FMC DO
      REPEAT
      RETURN
***********************************************************************
9900:* WRAP UP AND QUIT ROUTINE
      IF BATCH.TOTAL THEN
         FOR PMT=1 TO NO.PMTS
            IF D.D(PMT)<1,RV$PRO.FLD.LOCATION>=BATCH.TOTAL.AMC THEN GO 9910
         NEXT PMT
         IF ASSIGNED(DEVSYS.VOC.FILE) THEN
            CLOSE DEVSYS.VOC.FILE
         END
         RETURN
9910:    IF CV(PMT)#"" THEN BATCH.TOTAL=OCONV(BATCH.TOTAL,CV(PMT))
         PRINT @(-1):'Total of ':D.D(PMT)<1,RV$PRO.FLD.DISPLAY>:' in Batch #':BATCH.NO
         PRINT "was ": BATCH.TOTAL
         PRINT
      END
9920:* Close the VOC file and exit
      IF ASSIGNED(DEVSYS.VOC.FILE) THEN
         CLOSE DEVSYS.VOC.FILE
      END
      DEVSYS.DICT.SWITCH = 0
      IF ASSIGNED(DEVSYS.DICT.FILE) THEN
         CLOSE DEVSYS.DICT.FILE
      END
      DEVSYS.DICT.FILE.NAME = ""
      IF ASSIGNED(DEVSYS.DATA.FILE) THEN
         CLOSE DEVSYS.DATA.FILE
      END
      DEVSYS.DATA.FILE.NAME = ""
      IF ASSIGNED(DEVSYS.R.FILE) THEN
         CLOSE DEVSYS.R.FILE
      END
      DEVSYS.R.FILE.NAME = ""
      RETURN
RESET.NEXT.AVAILABLE:
      READU Q FROM DICT.DATA.FILE, '&NEXT.AVAILABLE&' ELSE Q='X':@FM
      Q<2> = USING.NEXT.AVAILABLE
      WRITE Q ON DICT.DATA.FILE,'&NEXT.AVAILABLE&'
      RETURN
PROMPTER:* PATTERN MATCHING SUBROUTINE
      VALID=D.D(PMT)<1,RV$PRO.FLD.MATCHFIELD>
      REQUIRED=D.D(PMT)<1,RV$PRO.FLD.REQUIRED>

* SETUP VARIABLES
      ANS=""
      OK=0
*MAINTAIN PROMPTING
BOTTOM.SCR:
      PRINT D.D(PMT)<1,RV$PRO.FLD.DISPLAY>:"=":

PMT.LOOP:

      INPUT ANS
      IF UPCASE(ANS[1,2]) EQ "C/" THEN
         FROM.STRING = FIELD(ANS,"/",2)
         TO.STRING = FIELD(ANS,"/",3)
         CURRENT.DATA = OCONV(INP(PMT)<1,LINE.NO>,CV(PMT))
         LEN.OF.FROM.STRING = LEN(FROM.STRING)
         START.POS.OF.FROM.STRING = INDEX(CURRENT.DATA,FROM.STRING,1)
         IF START.POS.OF.FROM.STRING EQ 0 THEN
            ANS = CURRENT.DATA
         END ELSE
            CHANGED.DATA=CURRENT.DATA[1,START.POS.OF.FROM.STRING-1]
            CHANGED.DATA:=TO.STRING
            CHANGED.DATA:=CURRENT.DATA[START.POS.OF.FROM.STRING+LEN.OF.FROM.STRING,9999]
            ANS = CHANGED.DATA
         END
         PRINT ANS
      END
      Q=ANS
      IF ANS # "" THEN
         IF INDEX(STD.RESP0,@FM:UPCASE(ANS):@FM,1) THEN
            ANS = UPCASE(ANS)
            Q = ANS
            OK = 1
            RETURN
         END
         IF FROM.SC2 THEN
            IF INDEX(STD2.RESP,@FM:ANS:@FM,1) THEN OK=1 ; RETURN       ; *006
         END
         INPUT.LEN = LEN(ANS)
         IF INPUT.LEN = 0 THEN INPUT.LEN = 1
         IF PMT=1 THEN IF UPCASE(ANS) = RV$CMD.END OR UPCASE(ANS) = RV$CMD.QUIT[1,INPUT.LEN] THEN OK=1 ; RETURN
      END ELSE
         IF FROM.SC2 THEN OK=1 ; RETURN
         IF REQUIRED = RV$PRO.VAL.REQUIRED THEN
            * entry required
            CALL *UVPRINTMSG(001578,"")
            GO BOTTOM.SCR
         END
         Q=ANS
         OK=1
         RETURN
      END
      GOSUB COMPARE
      IF OK THEN
         IF CV(PMT)#"" THEN
            OK=0
            GOSUB CONVERT
            IF NOT(OK) THEN
               GO BOTTOM.SCR
            END
         END
         Q=ANS
         RETURN
      END
      GO BOTTOM.SCR
COMPARE:
*  START VALIDATION LOOP
      IF VALID="" THEN
         OK=1
         RETURN
      END
      INPUT.LEN = LEN(ANS)
      IF INPUT.LEN = 0 THEN INPUT.LEN = 1
      IF PMT=1 THEN IF UPCASE(ANS) = RV$CMD.QUIT[1,INPUT.LEN] OR UPCASE(ANS) = RV$CMD.END THEN OK=1 ; RETURN
      I=0
      LOOP
         I += 1
         VUNIT=FIELD(VALID,@SVM,I)
      UNTIL VUNIT='' DO
         IF VUNIT[1,1] = "(" THEN
            * Range check required if VUNIT looks like "(LOW,HIGH)":
            IF VUNIT MATCHES "'('0N','0N')'" THEN
               IF NOT(NUM(ANS)) THEN GO TRY.NEXT
               LOW=MATCHFIELD(VUNIT,"1X0N1X0N1X",2)
               HIGH=MATCHFIELD(VUNIT,"1X0N1X0N1X",4)
               IF ANS < LOW OR ANS > HIGH THEN GOTO TRY.NEXT
               OK=1
               GOTO TRY.NEXT
            END
            * Upper bound check required if VUNIT looks like "(NNNN)":
            VUNIT=FIELD(VUNIT[2,99],')',1)
            IF NUM(VUNIT) THEN
               IF NOT(NUM(ANS)) THEN GO TRY.NEXT
               IF ANS LT 0 OR ANS GT VUNIT THEN GO TRY.NEXT
               OK=1
               RETURN
            END
            * Date conversion check required if VUNIT looks like "D...":
            IF VUNIT[1,1]="D" THEN
               GOSUB DATE.CONVERSION
               GOTO TRY.NEXT
            END
            * Number conversion check required if VUNIT looks like "MD...":
            IF VUNIT[1,2]="MD" THEN
               GOSUB DECIMAL.CONVERSION
               GO TRY.NEXT
            END
         END
*  ITS NOT A CONVERSION, MUST BE A PATTERN  *
         IF ANS MATCHES VUNIT THEN
            OK=1
            RETURN
         END
TRY.NEXT:IF OK THEN RETURN
      REPEAT
* invalid conversion code (or pattern, or range check)
* Message = "%s" does not pass input validation (%s)
      CALL *UVPRINTMSG(001570,ANS:@FM:CONVERT(@SVM, '/', VALID))
      OK=0
      RETURN
DATE.CONVERSION:
      ANS1 = ICONV(ANS,VUNIT)
      IF STATUS() THEN
         IF ANS = @NULL.STR THEN
            OK = 1
         END ELSE
            GO BAD.CONV
         END
      END ELSE
         OK = 1
         ANS=ANS1
      END
      RETURN
DECIMAL.CONVERSION:
      IF NUM(ANS) THEN ANS1 = ICONV(ANS,VUNIT) ELSE RETURN
      IF STATUS() THEN
         IF ANS = @NULL.STR THEN
            OK = 1
         END ELSE
            GO BAD.CONV
         END
      END ELSE
         OK = 1
         ANS = ANS1
      END
      RETURN
CONVERT:
      ANS1 = ICONV(ANS,CV(PMT))
      IF STATUS() THEN
         IF ANS = @NULL.STR THEN
            OK = 1
         END ELSE
            GO BAD.CONV
         END
      END ELSE
         OK = 1
         ANS = ANS1
      END
      RETURN
BAD.CONV:
      IF STATUS() EQ 3 THEN PRINT "WARNING - That is a funny looking date!" ; ANS=ANS1 ; OK=1 ; RETURN
      IF STATUS() EQ 2 THEN
         @SYSTEM.SET = -1
         PRINT D.D(PMT)<1,RV$PRO.FLD.DISPLAY>:" has an invalid conversion (":CV(PMT):")"
         GO 9920
      END
      PRINT @SYS.BELL:"'":ANS:"' is not a legal ":
      X=CV(PMT)
      IF X[1,1] EQ 'D' THEN PRINT 'date (':X:').' ; RETURN
      IF X[1,2] EQ 'MD' THEN PRINT 'decimal number (':X:').' ; RETURN
      IF X[1,2] EQ 'MB' THEN PRINT 'binary number (':X:').' ; RETURN
      IF X[1,2] EQ 'MO' THEN PRINT 'octal number (':X:').' ; RETURN
      IF X[1,2] EQ 'MX' THEN PRINT 'hexadecimal number (':X:').' ; RETURN
      IF X[1,2] EQ 'MT' THEN PRINT 'time of day (':X:').' ; RETURN
      PRINT "Conversion error."
      RETURN

CLEAR.OPCODES:
      IF ORIGINAL.TYPE # TempRec<2> THEN
         MATPARSE ITEM.ARRAY FROM TempRec, @FM
         TempRec = ""
         BEGIN CASE
            CASE ITYPE = 1
               FOR I = 1 TO 13
                  TempRec := ITEM.ARRAY(I):@FM
               NEXT I
            CASE DTYPE = 1
               FOR I = 1 TO 7
                  TempRec := ITEM.ARRAY(I):@FM
               NEXT I
               TempRec = TempRec[1,LEN(TempRec)-1]
         END CASE
      END
      RETURN

PRINT.TIMEDATE:
      DATE.CREATED = DATE()
      TIME.CREATED = TIME()
      DATETIME = OCONV(DATE.CREATED,'DWAL')[1,3]:' '
      DATETIME := OCONV(DATE.CREATED,'DMAL')[1,3]:' '
      DATETIME := OCONV(DATE.CREATED,'DD'):' '
      DATETIME := OCONV(TIME.CREATED,'MTS'):' '
      DATETIME := OCONV(DATE.CREATED,'DY4')
      PRINT DATETIME
      RETURN

ReplaceData:
      PMTstring    = ""
      PMTsubstring = ""
      PMTvalues    = 0
      IF ISNULL(Q) THEN
         PMTinput  = @null.str
      END ELSE
         PMTinput  = Q
      END
      ReplaceDone  = FALSE
      LOOP
         REMOVE PMTtoken FROM INP(PMT) SETTING RMdelimiter
         IF ISNULL(PMTtoken) THEN
            PMTtoken = @null.str
         END
      WHILE RMdelimiter DO
         RMdelimiter = CHAR(256 - RMdelimiter)
         BEGIN CASE
            CASE RMdelimiter = DMdelimiter
               PMTvalues += 1
               IF PMTvalues = LINE.NO THEN
                  PMTsubstring = PMTinput:RMdelimiter
                  ReplaceDone = TRUE
               END ELSE
                  PMTsubstring := PMTtoken:RMdelimiter
               END
               PMTstring := PMTsubstring
               PMTsubstring = ""
            CASE RMdelimiter < DMdelimiter
               IF PMTvalues = LINE.NO ELSE
                  PMTsubstring := PMTtoken:RMdelimiter
               END
            CASE RMdelimiter > DMdelimiter
               PRINT "Invalid data"
         END CASE
      REPEAT

      IF ReplaceDone THEN
         PMTsubstring := PMTtoken
      END ELSE
         PMTvalues += 1
         IF PMTvalues = LINE.NO THEN
            PMTsubstring = ""
         END ELSE
            PMTsubstring := PMTtoken:DMdelimiter
         END
         PMTsubstring := PMTinput
      END
      PMTstring := PMTsubstring
      INP(PMT) = PMTstring
      RETURN

   END