$OPTIONS A
** BP, CREATE.PROGRAM
* ITEM    LAST UPDATED:15:39:10 26 JUL 1985
*
* ITEM    LAST UPDATED:08:57:27  06 FEB 1985
*
**-- CREATE.PROGRAM RELEASE 1.0  --  01/08/85
*
* PROG.NAME = 'CREATE.PROGRAM'
  EXECUTE 'HUSH ON'
* INPUT PROG.NAME
  PROG.NAME = 'QUICKY'
  EXECUTE 'HUSH OFF'
  FIRST.PROG = PROG.NAME
CHNG.FIELDS = '6}48}21}12}19}95}58}24}25}43}22}11}8}54'
  FL = ''
  OPEN '','TEXT' TO F.TEXT ELSE FL = FL : ' TEXT'
  OPEN '','MCF' TO F.MCF ELSE FL = FL : ' MCF'
  IF FL # '' THEN
    PRINT 'UNABLE TO OPEN THE FOLLOWING FILES...'
    PRINT FL[2,999]
    STOP
  END
  FILE.SPECS.OPENED = 1
  OPEN '','FILE.SPECS' TO F.FILE.SPECS ELSE FILE.SPECS.OPENED=0
  DIM TEXT(100), SCRN(10)
  MATREAD TEXT FROM F.TEXT, PROG.NAME ELSE
    PRINT 'UNABLE TO READ ':PROG.NAME:' FROM THE "TEXT" FILE'
    STOP
  END
  FILE.NAME = TEXT(1)
  FL = ''
  OPEN '',FILE.NAME TO F.FILE ELSE FL = FL : ' ':FILE.NAME
  IF FL # '' THEN
    PRINT 'UNABLE TO OPEN THE FOLLOWING FILES...'
    PRINT FL[2,999]
    STOP
  END
  FILE.SPECS.OPENED = 1
*
**-- SET UP SOME COMMONLY USED VARIABLES
*
  PROMPT ''
  FM = CHAR(254); AM = FM; VM = CHAR(253); SVM = CHAR(252)
  LINKING = 0; KEY = ''
  EQU PAGING TO TEXT(32)
  EQU AUTO.ID TO TEXT(46)
  EQU PRNT.NUMBERS TO TEXT(83)
  EQU MV.DIR TO TEXT(85)
  EQU MV.DEL TO TEXT(86)
  EQU MV.INS TO TEXT(87)
  EQU MV.UNIQ TO TEXT(88)
  EQU NXT.REQ.FLD TO TEXT(89)
  EQU CNTRL.FWRD TO TEXT(59)
  EQU CNTRL.BCK TO TEXT(60)
  EQU CNTRL.EXIT TO TEXT(90)
  EQU CNTRL.QUIT TO TEXT(91)
  EQU CNTRL.FILE TO TEXT(92)
  EQU SINGLE.MODIFY TO TEXT(93)
  EQU CREATE.XREF.FLD TO TEXT(94)
  EQU PROMPT.FOR.KEY TO TEXT(61)
  EQU XREFED TO TEXT(95)
  EQU JUMP.INTO.ASSOC TO TEXT(96)
  EQU END.IN.ASSOC TO TEXT(97)
  EQU FAST.KEY TO TEXT(98)
  EQU TITLE TO TEXT(99)
  EQU DEFAULT TO TEXT(58)
  EQU PROMPT.AT.BOTTOM TO TEXT(84)
  EQU FORWARD.PROC TO TEXT(40)
  EQU BACK.PROC TO TEXT(41)
  EQU PROMPTS TO TEXT(7)
  EQU PROMPT.X TO TEXT(17)
  EQU PROMPT.Y TO TEXT(18)
  EQU SCREEN.NAME TO TEXT(19)
  EQU XTRA.X TO TEXT(13)
  EQU XTRA.Y TO TEXT(14)
  EQU XTRA.DATA TO TEXT(45)
  EQU XTRA.NAME TO TEXT(30)
  EQU FIELDS TO TEXT(20)
  EQU REQUIRED TO TEXT(8)
  EQU MV.SV TO TEXT(6)
  EQU NO.OF.ASSOC TO TEXT(48)
  EQU DATA.X TO TEXT(15)
  EQU DATA.Y TO TEXT(16)
  EQU MIN.LNGTH TO TEXT(21)
  EQU MAX.LNGTH TO TEXT(12)
  EQU CONVERSIONS TO TEXT(24)
  EQU FORMAT TO TEXT(5)
  EQU MATCHINGS TO TEXT(11)
  EQU NO.PROMPTS TO TEXT(25)
  EQU FILL TO TEXT(43)
  EQU TRANSLATES TO TEXT(22)
  EQU HELPS TO TEXT(54)
  RECORD = ''; BS.5 = STR(CHAR(8),5)
**-- RESERVED INPUTS FOR CONTROLLING FUNCTIONS
  BACKUP = '/'
  CNTRL.PNT = '.'
  TERMINATE = 'EX'
  RESTART = 'EX'
  LEFT.DELIMITER = '['
  RIGHT.DELIMITER = ']'
**-- SET UP VARIABLES
3 PRNT.NUMBERS = (PRNT.NUMBERS="Y")
  PROMPT.FOR.KEY = (PROMPT.FOR.KEY#"N")
  PROMPT.AT.BOTTOM = (PROMPT.AT.BOTTOM="Y")
  MV.DIR = (MV.DIR="Y")
  MV.DEL = (MV.DEL="Y")
  MV.INS = (MV.INS="Y")
  MV.UNIQ = (MV.UNIQ="Y")
  IF NXT.REQ.FLD = '' THEN NXT.REQ.FLD = CHAR(251)
  NO.OF.PROMPTS = COUNT(PROMPTS,VM)+(PROMPTS#'')
  MAT SCRN = @(-1)
  SCREEN.NAMES = ''
  X = 1; PAGE.NO=1; XREF.FLAG = 0
*
**-- BUILD OUR SCREENS
*
  COUNTX = COUNT(PROMPTS,VM)+(PROMPTS#'')
**-- PUT THE PROMPTS ON THE SCREEN
  FOR I = 1 TO COUNTX
    FIL = ''
    IF FILL<1,I> = 'Y' THEN
      FIL = STR('.',DATA.X<1,I,1>-PROMPT.X<1,I,1>-LEN(PROMPTS<1,I,1>)-5)
    END
    IF SCREEN.NAME<1,I> # '' THEN
*     LOCATE(SCREEN.NAME<1,I>,SCREEN.NAMES,1,0;XX) ELSE
      LOCATE SCREEN.NAME<1,I> IN SCREEN.NAMES<1,1> SETTING XX ELSE
        XX = COUNT(SCREEN.NAMES,VM)+2
        SCREEN.NAMES<1,XX> = SCREEN.NAME<1,I>
      END
    END ELSE XX = 1
    IF I # 1 THEN
      SCRN(XX) = SCRN(XX) : @(PROMPT.X<1,I>,PROMPT.Y<1,I>): (I-1)'R#3':'.':PROMPTS<1,I> : FIL
    END ELSE
      SCRN(XX) = SCRN(XX) : @(PROMPT.X<1,I>,PROMPT.Y<1,I>):PROMPTS<1,I> : FIL
    END
  NEXT I
**-- PUT XTRA DATA ON THE SCREEN
  COUNTX = COUNT(XTRA.DATA,VM)+(XTRA.DATA#'')
  FOR I = 1 TO COUNTX
    COUNTY = COUNT(XTRA.DATA<1,I>,SVM)+(XTRA.DATA<1,I>#'')
    IF XTRA.NAME<1,I> # '' THEN
*     LOCATE(XTRA.NAME<1,I>,SCREEN.NAMES,1,0;XX) ELSE
      LOCATE XTRA.NAME<1,I> IN SCREEN.NAMES<1,1> SETTING XX ELSE
        XX = COUNT(SCREEN.NAMES,VM)+2
        SCREEN.NAMES<1,XX> = XTRA.NAME<1,I>
      END
    END ELSE XX = 1
    FOR Y = 1 TO COUNTY
      SCRN(XX) = SCRN(XX) : @(XTRA.X<1,I,Y>,XTRA.Y<1,I,Y>):XTRA.DATA<1,I,Y>
    NEXT Y
  NEXT I
*
**-- PRINT OUR SCREEN
*
*5  LOCATE(SCREEN.NAME<1,1>,SCREEN.NAMES,1,0;XX) ELSE XX = 1
5 LOCATE SCREEN.NAME<1,1> IN SCREEN.NAMES<1,1> SETTING XX ELSE XX = 1
  PRINT SCRN(XX):
  IF TITLE#'' THEN
     X.POS = INT(40-LEN(TITLE)/2)
     PRINT @(0,0):'<< ':OCONV(TIME(),'MTH'):@(X.POS,0):TITLE:@(65,0):OCONV(DATE(),'D'):' >>':
  END
  IF NOT(LINKING) THEN RECORD = ''
*
**-- PROMPT USER FOR RECORD ID
*
10 IF NOT(LINKING) AND PROMPT.FOR.KEY THEN
    MX.LNGTH = MAX.LNGTH<1,1>+1
    HERE = @(DATA.X<1,1>,DATA.Y<1,1>)
    IF PROMPT.AT.BOTTOM THEN
      PRINT @(0,22):@(-4):PROMPTS<1,1>:' :':; INPUT KEY,MX.LNGTH
    END ELSE
      PRINT HERE:STR(' ',MX.LNGTH-1):RIGHT.DELIMITER:HERE:CHAR(8):LEFT.DELIMITER:
      PRINT HERE:; INPUT KEY,MX.LNGTH
    END
  END
  PRINT HERE:CHAR(8):STR(' ',MX.LNGTH+1):
  IF KEY = TERMINATE THEN PRINT @(-1); STOP
  PAGE.NO=1; ANS = KEY;  Z = 1; X=1; MV.CNT = 1; FLD = 0
**-- DEFAULT ENTRY LOGIC
  IF ANS = '' AND DEFAULT<1,Z>#'' THEN
    IF DEFAULT<1,Z> = 'DATE()' THEN
      ANS = OCONV(DATE(),'D2/')
    END ELSE
      ANS = DEFAULT<1,Z>
    END
    KEY = ANS
  END
  IF ANS = '?' OR ANS = '??' THEN GOSUB 6000; GOTO 10; ** HELPS
  IF ANS = '' AND REQUIRED<1,1> = 'Y' THEN
     ERROR = 'ENTRY REQUIRED'; GOSUB 9000; GOTO 10
  END
  FLD = FIELDS<1,Z>
  FMT = FORMAT<1,Z>
  CNV = CONVERSIONS<1,Z>
  MCTH = MATCHINGS<1,Z>
  MX.LNGTH = MAX.LNGTH<1,Z>+1
  ERROR = ''
  GOSUB 8000; *** EDIT CHECKS
  IF ERROR # '' THEN GOTO 10
  ITM = KEY
  IF CNV # '' THEN
    KEY = ICONV(KEY,CNV)
    ITM = OCONV(KEY,CNV)
  END
  PRINT @(DATA.X<1,1>,DATA.Y<1,1>):ITM FMT
  IF NOT(LINKING) THEN
    OLD.RECORD = ''
    TEST = 1
    READ RECORD FROM F.FILE, KEY ELSE TEST = 0
    IF TEST THEN
      GOSUB 7005; OLD.RECORD = RECORD; GOTO 99
    END
  END ELSE GOSUB 7005; LINKING = 0; GOTO 99
  LINKING = 0
*
**-- PROMPT USER FOR ITEMS
*
  START = 2; MV.START = 0; FINISH = NO.OF.PROMPTS
*
**-- LOOP THRU PROMPTS
*
20 FOR I = START TO FINISH
    MOD.SCRN = COUNT(DATA.X<1,I>,SVM)+(DATA.X<1,I>#'')
    IF MV.SV<1,I> = 'M' OR MOD.SCRN > 1 THEN MV.CNT = 99999 ELSE MV.CNT=1
    ASSOC = NO.OF.ASSOC<1,I>+I
    OLD.WINDOW = 9999
    IF MV.START=0 THEN MV.START = 1
*
**-- LOOP THRU VALUE POSITIONS
*
    FOR X = MV.START TO MV.CNT
      IF PAGING='Y' THEN VMC=PAGE.NO;SVMC=X ELSE VMC=X; SVMC=0; ** SETUP FOR PAGING SCRNS
      IF MV.CNT > 1 THEN
        WINDOW = INT(X/MOD.SCRN)+(MOD(X,MOD.SCRN)#0)
        IF WINDOW # OLD.WINDOW THEN GOSUB 5000; OLD.WINDOW = WINDOW; *** PAINT WINDOW
      END
*
**-- LOOP THRU ASSOCIATED FIELDS
*
      X1 = MOD(X-1,MOD.SCRN)+1
      FOR Z = I TO ASSOC
        FLD = FIELDS<1,Z>
        FMT = FORMAT<1,Z>
        CNV = CONVERSIONS<1,Z>
        MCTH = MATCHINGS<1,Z>
        MX.LNGTH = MAX.LNGTH<1,Z>+1
        IF SCREEN.NAME<1,Z> # SCREEN.NAMES<1,XX> THEN
*         LOCATE(SCREEN.NAME<1,Z>,SCREEN.NAMES,1,0;XX) ELSE XX = 1
          LOCATE SCREEN.NAME<1,Z> IN SCREEN.NAMES<1,1> SETTING XX ELSE XX = 1
          GOSUB 7000; *** PRINT SCREEN
        END
        HERE = @(DATA.X<1,Z,X1>,DATA.Y<1,Z,X1>)
**-- DISPLAY CURRENT DATA AND GET USERS RESPONSE TO PROMPT
*
**-- IF JUMP TO NEXT REQUIRED FIELD REQUESTED... SEARCH FOR NEXT REQ FLD
30      ITM = RECORD<FLD,VMC,SVMC>
        IF ANS = NXT.REQ.FLD AND REQUIRED<1,Z> # 'Y' THEN
          IF ITM = '' THEN
            IF Z = I AND MV.CNT > 1 THEN Z = ASSOC; X = 999999
          END
          GOTO 40
        END
        PRINT HERE:STR(' ',MX.LNGTH-1):RIGHT.DELIMITER:HERE:CHAR(8):LEFT.DELIMITER:
        IF CNV#'' THEN ITM = OCONV(ITM,CNV)
        PRINT ITM FMT:
        IF NO.PROMPTS<1,Z> = 'Y' THEN
          IF I = ASSOC THEN X = 999999
          GOTO 40
        END
        IF PROMPT.AT.BOTTOM THEN
          PRINT @(0,22):@(-4):PROMPTS<1,Z>:' :':
        END ELSE PRINT HERE:
        INPUT ANS,MX.LNGTH
        PRINT HERE:CHAR(8):STR(' ',MX.LNGTH+1):
        IF ANS = '?' OR ANS = '??' THEN GOSUB 6000; GOTO 30; ** HELPS
        IF ANS = '' THEN ANS = ITM
**-- DEFAULT ENTRY LOGIC
        IF ANS = '' AND DEFAULT<1,Z>#'' THEN
          IF DEFAULT<1,Z> = 'DATE()' THEN
            ANS = OCONV(DATE(),'D2/')
          END ELSE
            ANS = DEFAULT<1,Z>
          END
        END
**-- IF A MV ITEM AND NULL ENTERED FOR DATA-SET ID THEN
**-- GO TO NEXT ITEM(PROMPT) NOT IN ASSOCIATED GROUP
        IF ANS = '' THEN
          PRINT HERE:ITM FMT:
          IF Z = I AND MV.CNT > 1 THEN Z=ASSOC; X=999999; GOTO 40
        END
*
**-- THIS SECTION PROVIDES THE ABILITY TO HANDLE SITUATIONS THAT
**-- ARISE FROM MULTI-PROMPTED ENTRIES.
*
        IF ((ASSOC > I AND Z=I) OR (ASSOC=I AND MV.CNT > 1)) AND ANS # BACKUP AND ANS # NXT.REQ.FLD THEN
**-- GO DIRECTLY TO A PARTICULAR VALUE POSITION
          IF MV.DIR AND (ANS MATCHES "'/'0N") THEN
            DMY.X = ANS[2,99]
            IF NOT(NUM(DMY.X)) THEN
              ERROR = 'INVALID VALUE-POSITION REFERENCE'
              GOSUB 9000; GOTO 30
            END
            IF DMY.X < 1 THEN
              ERROR = 'INVALID VALUE-POSITION REFERENCE'
              GOSUB 9000; GOTO 30
            END
            PRINT HERE: ITM FMT:
            X = DMY.X - 1; Z = ASSOC; GOTO 40
          END
**-- DELETE & INSERT A VALUE POSITION LOGIC
          IF (ANS = '/D' AND MV.DEL) OR (ANS = '/I' AND MV.INS) THEN
            FOR ZZ = I TO ASSOC
              IF ANS = '/D' THEN RECORD = DELETE(RECORD,FIELDS<1,ZZ>,VMC,SVMC)
              IF ANS = '/I' AND RECORD<FIELDS<1,ZZ>>#'' THEN RECORD = INSERT(RECORD,FIELDS<1,ZZ>,VMC,SVMC,'')
            NEXT ZZ
            GOSUB 5000; X1 = MOD(X-1,MOD.SCRN)+1; GOTO 30
          COUNTZZ = COUNT(CHNG.FIELDS,VM)+(CHNG.FIELDS#'')
          FOR ZZ = 1 TO COUNTZZ
              IF ANS = '/D' THEN RECORD = DELETE(RECORD,CHNG.FIELDS<1,ZZ>,VMC,SVMC)
              IF ANS = '/I' AND RECORD<CHNG.FIELDS<1,ZZ>>#'' THEN RECORD = INSERT(RECORD,CHNG.FIELDS<1,ZZ>,VMC,SVMC,'')
          NEXT ZZ
          END
          ITM = RECORD<FLD,VMC,SVMC>
          IF CNV#'' THEN ITM = OCONV(ITM,CNV)
          PRINT HERE:ITM FMT:
**-- LET DATA SET ID HAVE CONTROL OF VALUE POSITION POINTER
          IF MV.UNIQ AND Z=I AND ANS # CNTRL.PNT THEN
            L.VMC=0;S.MRK=VM; IF PAGING='Y' THEN L.VMC=VMC;S.MRK=SVM
*           LOCATE(ANS,RECORD,FLD,L.VMC;X) ELSE
*           LOCATE ANS IN RECORD<FLD,L.VMC> USING S.MRK SETTING X ELSE
            TEST = 0
            IF L.VMC # 0 THEN
               LOCATE ANS IN RECORD<FLD,1> SETTING X ELSE TEST = 1
            END ELSE
               LOCATE ANS IN RECORD<FLD,VMC,1> SETTING X ELSE TEST = 1
            END
            IF TEST THEN
              X = COUNT(RECORD<FLD,L.VMC>,S.MRK)+(RECORD<FLD,L.VMC>#'')+1
            END
            IF PAGING='Y' THEN VMC=PAGE.NO;SVMC=X ELSE VMC=X; SVMC=1
            X1 = MOD(X-1,MOD.SCRN)+1
            HERE = @(DATA.X<1,I,X1>,DATA.Y<1,I,X1>)
            WINDOW = INT(X/MOD.SCRN)+(MOD(X,MOD.SCRN)#0)
            IF WINDOW # OLD.WINDOW THEN
              GOSUB 5000; OLD.WINDOW = WINDOW; *** PAINT WINDOW
            END
            X1=MOD(X-1,MOD.SCRN)+1
          END
        END
        IF ANS = BACKUP OR ANS = CNTRL.PNT OR ANS = NXT.REQ.FLD THEN
          PRINT HERE:ITM FMT
        END
        IF ANS = RESTART THEN RECORD = ''; GOTO 107
        IF END.IN.ASSOC # 'Y' AND ANS=CNTRL.PNT AND I # Z THEN
          ERROR = 'UNABLE TO "':CNTRL.PNT:'" IN THE MIDDLE OF AN ASSOCIATION'
          GOSUB 9000; GOTO 30
        END
        IF ANS = CNTRL.PNT THEN GOTO 99;** CONTROL POINT
        IF ANS = NXT.REQ.FLD THEN GOTO 40
**-- BACK UP TO PREVIOUS PROMPT LOGIC
        IF ANS = BACKUP THEN
          Z = Z - 2 ;         *** BACK UP TO PREVIOUS ASSOC ITEM
          IF Z < (I-1) THEN
            Z=9999999; X = X - 2;** BACKUP TO PREVIOUS VALUE POS
            IF X < 0 THEN
              X = 999999;** BACKUP TO PREVIOUS PROMPT
              ASSOC = I - 2
              IF ASSOC < 2 THEN ASSOC = 1
            END
          END
          GOTO 40
        END
**-- REQUIRED ITEM DURING PROMPTING LOGIC
        IF REQUIRED<1,Z> = 'Y' AND ANS = '' THEN
          ERROR = 'ENTRY REQUIRED'
          GOSUB 9000; GOTO 30;  **** ERROR ROUTINE
        END
        IF REQUIRED<1,Z> # 'Y' AND ANS = '' THEN GOTO 40
        ERROR = ''
        GOSUB 8000; *** EDIT CHECKS
        IF ERROR # '' THEN GOTO 30
**-- IF SPECIAL EDITS ARE TO BE DONE ON A FIELD BY
**-- FIELD BASIS, THEN THE EDIT CHECKS SHOULD COME
**-- JUST AFTER THESE COMMENTS IN THE FORM OF
**-- CASE STATEMENTS
**--  EXAMPLE:
*          IF PROG.NAME = 'XXX' THEN
*            BEGIN CASE
*                CASE FLD = 16
*                   PRINT 'THIS IS A TEST'
*            END CASE
*          END
**--
        ITM1 = ANS
        IF CNV # '' THEN ITM1 = ICONV(ITM1,CNV)
        IF ANS = ' ' THEN ITM1 = ''
        RECORD<FLD,VMC,SVMC> = ITM1
        IF CNV # '' THEN ITM1 = OCONV(ITM1,CNV)
        PRINT HERE:ITM1 FMT:
40    NEXT Z
    NEXT X
    MV.START=0
**-- UPDATE PROMPTING SEQUENCE WITH THE NEXT PROMPT
**-- AFTER THE ITEMS IN ASSOCIATION
    I = ASSOC
  NEXT I
*
**-- CONTROL POINT STUFF
*
99 IF PAGING = 'Y' THEN
    IF FORWARD.PROC#'' OR BACK.PROC#'' THEN
      PRINT @(0,23):@(-4):'"':CNTRL.FWRD:'", "':CNTRL.BCK:'",':
    END
    PRINT @(18,23):@(-4):' "P#" - GO TO PAGE#, "PD" - PAGE DELETE, "PI" - PAGE INSERT':
    PRINT @(0,22):@(-4):@(2,22):'MODIFY -- (NN) REFERENCE, "':CNTRL.FILE:'" - FILE, "':CNTRL.QUIT:'" - QUIT, "':CNTRL.EXIT:'" - EXIT :':; INPUT ANS
  END ELSE
    IF FORWARD.PROC#'' OR BACK.PROC#'' THEN
      PRINT @(0,23):@(-4):'           "':CNTRL.FWRD:'", "':CNTRL.BCK:'"':
    END
    PRINT @(0,22):@(-4):@(2,22):'MODIFY -- (NN) REFERENCE, "':CNTRL.FILE:'" - FILE, "':CNTRL.QUIT:'" - QUIT, "':CNTRL.EXIT:'" - EXIT :':; INPUT ANS
  END
  X=1
  IF ANS = 'Q' THEN
     CALL PROG.QUIRY(RECORD,KEY)
     GOSUB 7000; GOTO 99
  END
  IF ANS = CNTRL.EXIT THEN PRINT @(-1); STOP
  IF ANS = CNTRL.QUIT THEN RECORD=''; GOTO 107
**-- CALL THE MEGA HELP ROUTINE
  IF ANS = '???' THEN CALL SUB.MENU.HELP(FAST.KEY); GOSUB 7000; GOTO 99
**-- LINK TO THE FORWARD OR BACK PROCEDURE
  IF ANS = CNTRL.FWRD OR ANS = CNTRL.BCK THEN
    LINKING = 1; GOSUB 90
    DMY = FORWARD.PROC
    IF ANS = CNTRL.BCK THEN DMY = BACK.PROC
    MATREAD TEXT FROM F.TEXT, DMY ELSE
      ERROR = 'UNABLE TO READ ':DMY:' FROM THE "TEXT" FILE.... LINK ATTEMPT ABORTED'
      GOSUB 9000; GOTO 99
    END
    PROG.NAME = DMY
    GOTO 3
  END
**-- GOTO PROMPT ITEM
  IF ANS[LEN(ANS),1] = '-' THEN
    ANS = ANS[1,LEN(ANS)-1]
    CONTIN = 1
  END ELSE CONTIN = 0
  IF NUM(ANS) THEN
    IF ANS < 1 OR INT(ANS) > NO.OF.PROMPTS-1 THEN
      ERROR = 'INVALID REFERENCE NUMBER'
      GOSUB 9000; **** ERROR ROUTINE
      GOTO 99
    END
    START = ANS+1
    MV.START = FIELD(START,'.',2); START = FIELD(START,'.',1)
    IF MV.START = '' THEN MV.START = 0
    IF SINGLE.MODIFY = 'Y' THEN FINISH = START ELSE FINISH = NO.OF.PROMPTS
    IF CONTIN THEN FINISH = NO.OF.PROMPTS
    IF NO.PROMPTS<1,START> = 'Y' THEN
      ERROR = 'NO ENTRY IS ALLOWED FOR REQUESTED ITEM'
      GOSUB 9000; **** ERROR ROUTINE
      GOTO 99
    END
    IF MV.SV<1,START>='M' AND JUMP.INTO.ASSOC#'Y' THEN
      IF NO.OF.ASSOC<1,START>#0 OR START = 2 THEN GOTO 20
      FOR I = START-1 TO 2 STEP -1
        IF MV.SV<1,I>#'M' THEN GOTO 20
        IF NO.OF.ASSOC<1,I>#0 THEN
          IF (START-I) <= NO.OF.ASSOC<1,I> THEN
            ERROR = 'UNABLE TO JUMP INTO AN ASSOCIATION'
            GOSUB 9000; GOTO 99
          END
        END
      NEXT I
    END
    GOTO 20;***  START PROMPTING
  END
  IF PAGING = 'Y' THEN
**-- GOTO A PAGE
    IF ANS[1,1] = 'P' AND NUM(ANS[2,99]) THEN
      IF ANS[2,99] > 0 THEN
        PAGE.NO = ANS[2,99]; XX=1; GOSUB 7005; GOTO 99
      END ELSE
        ERROR = 'INVALID PAGE NUMBER'
        GOSUB 9000; GOTO 99
      END
    END
**-- DELETE & INSERT A PAGE LOGIC
    IF ANS = 'PD' OR ANS = 'PI' THEN
      FOR I = 2 TO NO.OF.PROMPTS
        IF ANS = 'PD' THEN
          RECORD = DELETE(RECORD,FIELDS<1,I>,PAGE.NO,0)
        END ELSE
          IF COUNT(RECORD<FIELDS<1,I>>,VM)+1 >= PAGE.NO THEN RECORD = INSERT(RECORD,FIELDS<1,I>,PAGE.NO,0,'')
        END
      NEXT I
      GOSUB 7005; GOTO 99
    END
  END
  IF ANS # CNTRL.FILE THEN
    ERROR = 'INVALID SELECTION... RETRY'
    GOSUB 9000; *** ERROR ROUTINE
    GOTO 99
  END
*
**-- FILE TIME STUFF
*
  *
  READ DMY FROM F.TEXT, 'CREATE.PROGRAM' ELSE DMY = ''
  COUNTX = COUNT(DMY<20>,VM)+(DMY#'')
  FOR I = 1 TO COUNTX
      FLDR = DMY<20,I>
      IF RECORD<FLDR>='' AND DMY<58,I>#'' THEN
         RECORD<FLDR> = DMY<58,I>
      END
  NEXT I
  COUNTX = COUNT(RECORD<20>,VM)+(RECORD<20>#'')
  FOR I = 1 TO COUNTX
    LNGTH = FIELD(RECORD<5,I>,'#',2)
    IF NUM(LNGTH) THEN RECORD<12,I> = LNGTH ELSE RECORD<12,I> = 25
    RECORD<21,I> = 0
    RECORD<6,I> = 'S'
    RECORD<43,I> = 'Y'
  NEXT I
  RECORD<99> = KEY
*
**-- VALIDATE REQUIRED ITEMS AT FILE TIME LOGIC
*
90 FOR I = 2 TO NO.OF.PROMPTS;    ** LOOP THRU PROMPTS
    COUNTX = COUNT(RECORD<FIELDS<1,I>>,VM)+1
    ASSOC = I + NO.OF.ASSOC<1,I>
    FOR X= 1 TO COUNTX;    *** LOOP THRU VALUE POSITIONS
      COUNTY = COUNT(RECORD<FIELDS<1,I>,X>,VM)+1
      FOR Y = 1 TO COUNTY; *** LOOP THRU SUB-VALUES
        FOR Z = I TO ASSOC;    *** LOOP THRU ASSOCIATED FIELDS
          IF REQUIRED<1,Z> = 'Y' AND RECORD<FIELDS<1,Z>,X,Y> = '' THEN
            ERROR = PROMPTS<1,Z>:' REQUIRES AN ENTRY'
            IF COUNTX > 1 THEN
              IF PAGING='Y' THEN
                ERROR = ERROR : ' ON PAGE "':X:'"'
                IF COUNTY > 1 THEN
                  ERROR = ERROR : ' LINE# "':Z:'"'
                END
              END ELSE
                ERROR = ERROR : ' ON LINE #':X
              END
            END
            GOSUB 9000; *** ERROR ROUTINE
            GOTO 99
          END
        NEXT Z
      NEXT Y
    NEXT X
  NEXT I
   *
**-- IF SPECIAL FILE TIME LOGIC IS REQUIRED,
**-- ENTER IT JUST AFTER THIS COMMENT LINE.....
   *
   *
**-- CREATE XREF IF NECESSARY
  IF CREATE.XREF.FLD#'' THEN
    OPEN '',FILE.NAME:'.XREF' TO F.XREF ELSE
      ERROR = 'UNABLE TO CREATE THE XREF FOR THIS ITEM BECAUSE XREF FILE NOT FOUND'
      GOSUB 9000; GOTO 100
    END
**-- TAKE OUT OLD XREF DATA
    COUNTX = COUNT(OLD.RECORD<CREATE.XREF.FLD>,' ')+(OLD.RECORD<CREATE.XREF.FLD>#'')
    FOR I = 1 TO COUNTX
      XREF.KEY = FIELD(OLD.RECORD<CREATE.XREF.FLD>,' ',I)
      READ XREF.DATA FROM F.XREF, XREF.KEY ELSE XREF.DATA = ''
      TEST = 1
*     LOCATE(KEY,XREF.DATA,1,0;XX) THEN
      LOCATE KEY IN XREF.DATA<1,1> SETTING XX ELSE TEST = 0
      IF TEST THEN
        XREF.DATA=DELETE(XREF.DATA,1,XX,0)
      END
      WRITE XREF.DATA ON F.XREF, XREF.KEY
    NEXT I
**-- CREATE NEW XREF DATA
    COUNTX = COUNT(RECORD<CREATE.XREF.FLD>,' ')+(OLD.RECORD<CREATE.XREF.FLD>#'')
    FOR I = 1 TO COUNTX
      XREF.KEY = FIELD(RECORD<CREATE.XREF.FLD>,' ',I)
      READ XREF.DATA FROM F.XREF, XREF.KEY ELSE XREF.DATA = ''
*     LOCATE(KEY,XREF.DATA,1,0;XX) ELSE XX = COUNT(XREF.DATA<1>,VM)+(XREF.DATA<1>#'')+1; XREF.DATA<1,XX>=KEY
      LOCATE KEY IN XREF.DATA<1,1> SETTING XX ELSE XX = COUNT(XREF.DATA<1>,VM)+(XREF.DATA<1>#'')+1; XREF.DATA<1,XX>=KEY
      WRITE XREF.DATA ON F.XREF, XREF.KEY
    NEXT I
  END
**-- ALL REQUIRED ITEMS HAVE ENTRIES... LETS' FILE RECORD
100 IF LINKING THEN RETURN
  IF PROMPT.FOR.KEY THEN
    IF AUTO.ID # '' AND KEY = '@' THEN
105    READV KEY FROM F.MCF, AUTO.ID,2 ELSE KEY = 1
       WRITEV KEY+1 ON F.MCF, AUTO.ID,2
       TEST =1
       READV DMY FROM F.FILE, KEY,1 ELSE TEST = 0
        IF TEST THEN GOTO 105
       ERROR = '"':KEY:'" HAS BEEN ASSIGN AS THE KEY TO THIS RECORD'
       GOSUB 9000
    END
    WRITE RECORD ON F.FILE, KEY
107 PROG.NAME = FIRST.PROG
    MATREAD TEXT FROM F.TEXT, PROG.NAME ELSE STOP
    GOTO 3; *** RESTART
  END
  GOTO 5;*** RESTART PROCEDURE
*
**-- PAINT WINDOWS FOR MV ENTRIES
*
5000 WNDW1 = INT((WINDOW-1)*MOD.SCRN+1);  *** STARTING POS. OF WINDOW
  WNDW2 = WINDOW*MOD.SCRN;             *** ENDING POS. OF WINDOW
  PAINT=''
  FOR IXZ = WNDW1 TO WNDW2
    X1 = MOD(IXZ-1,MOD.SCRN)+1
    FOR ZZ1 = I TO ASSOC
      IF PAGING='Y' THEN ZQ=PAGE.NO;ZQ1=IXZ ELSE ZQ=IXZ;ZQ1=1
      CNV1 = CONVERSIONS<1,ZZ1>
      PAINT=PAINT: @(DATA.X<1,ZZ1,X1>,DATA.Y<1,ZZ1,X1>)
      IF ZZ1 = I AND PRNT.NUMBERS THEN PAINT=PAINT: BS.5: IXZ'R#3':') '
      ITM2 = RECORD<FIELDS<1,ZZ1>,ZQ,ZQ1>
      IF CNV1#'' AND ITM2#'' THEN ITM2 = OCONV(ITM2,CNV1)
      IF ITM2 # '' THEN PAINT=PAINT: ITM2 FORMAT<1,ZZ1> ELSE PAINT=PAINT: STR(' ',MAX.LNGTH<1,ZZ1>)
    NEXT ZZ1
  NEXT IXZ
  PRINT PAINT:; PAINT=''
  RETURN
*
**-- DISPLAY HELP STUFF
*
6000 PRINT @(-1):@(34,0):'*** HELPS ***'
  HLP = ''
  HLP<-1> = 'HELP FOR : "':PROMPTS<1,Z>:'"'
  IF REQUIRED<1,Z> = 'Y' THEN
    HLP<-1> = 'ENTRY IS REQUIRED'
  END ELSE
    HLP<-1> = 'ENTRY IS NOT REQUIRED'
  END
  HLP<-1> = 'MINIMUM LENGTH OF ENTRY IS ':MIN.LNGTH<1,Z>:' CHARACTERS'
  HLP<-1> = 'MAXIMUM LENGTH OF ENTRY IS ':MAX.LNGTH<1,Z>:' CHARACTERS'
  IF MATCHINGS<1,Z> # '' THEN
    HLP<-1> = 'ENTRY MUST MEET THIS MATCH PATTERN : "':MATCHINGS<1,Z>:'"'
  END
  IF TRANSLATES<1,Z> # '' THEN
    TRNSL = TRANSLATES<1,Z>
    T.FILE = FIELD(TRNSL,',',1)
    MUST.EXIST = FIELD(TRNSL,',',3)
    DISPLAY.FLAG = FIELD(TRNSL,',',4)
    T.FLD = FIELD(TRNSL,',',5)
    HLP<-1> = 'ENTRY WILL BE TRANSLATED TO THE "':T.FILE:'" FILE'
    IF MUST.EXIST THEN
      HLP<-1> = 'THIS TRANSLATION MUST OCCUR, OR AN ERROR CONDITION WILL OCCUR'
    END
    IF DISPLAY.FLAG = '1' THEN
      HLP<-1> = 'FIELD ':T.FLD:' OF THE ':T.FILE:' FILE WILL BE DISPLAYED'
    END
  END
  IF MV.CNT > 1 THEN
    IF MV.DIR THEN
      HLP<-1> = 'AN ENTRY OF "/###" WILL TAKE YOU TO DATA-SET "###"'
    END
    IF MV.DEL THEN
      HLP<-1> = 'AN ENTRY OF "/D" WILL DELETE THE CURRENT DATA-SET'
    END
    IF MV.INS THEN HLP<-1> = 'AN ENTRY OF "/I" WILL INSERT A DATA-SET'
  END
  IF FLD # '0' THEN
    HLP<-1> = 'AN ENTRY OF "':CNTRL.PNT:'" WILL TAKE YOU TO THE CONTROL POINT'
    HLP<-1> = 'AN ENTRY OF "':BACKUP:'" WILL TAKE YOU TO THE PREVIOUS PROMPT'
    HLP<-1> = 'AN ENTRY OF "':RESTART:'" WILL EXIT THIS RECORD'
  END ELSE
    HLP<-1> = 'AN ENTRY OF "':TERMINATE:'" WILL TAKE YOU OUT OF THIS PROCEDURE'
    IF AUTO.ID # '' THEN
       HLP<-1> = 'AN ENTRY OF "@" WILL ALLOW THE COMPUTER TO ASSIGN THE RECORD I.D.'
    END
  END
* IF FILE.SPECS.OPENED THEN
*   READ SPECS.DATA FROM F.FILE.SPECS, FILE.NAME:'*':FLD ELSE SPECS.DATA=''
*   COUNTIXZ = COUNT(SPECS.DATA<3>,VM)+(SPECS.DATA<3>#'')
*   FOR IXZ = 1 TO COUNTIXZ
*     HLP<-1>=SPECS.DATA<3,IXZ>
*   NEXT IXZ
* END
  COUNTIXZ = COUNT(HELPS<1,Z>,SVM)+(HELPS<1,Z>#'')
  FOR IXZ = 1 TO COUNTIXZ
    HLP<-1> = HELPS<1,Z,IXZ>
  NEXT IXZ
6010 COUNTIXZ = COUNT(HLP,FM)+(HLP#'')
  SCRN.CNT = 1
  SCRN.MAX = 19
  MSG = 'PRESS <RETURN> TO CONTINUE :'; MSG.HDR = '*** HELPS ***'
  IF XREF.FLAG THEN MSG = 'ENTER SELECTION OR <RETURN> :'; MSG.HDR = '* CROSS REFERENCE *'
  FOR IXZ = 1 TO COUNTIXZ
    YR = 40-LEN(HLP<IXZ>)/2
    SCRN.CNT = SCRN.CNT + 1
    PRINT @(YR,SCRN.CNT):HLP<IXZ>
    IF SCRN.CNT > SCRN.MAX THEN
      PRINT @(0,22):@(-4):MSG:; INPUT DMY
      IF XREF.FLAG AND DMY # '' THEN RETURN
      SCRN.CNT = 1
      PRINT @(-1):@(36,0): MSG.HDR
    END
  NEXT IXZ
  PRINT @(0,22):@(-4):MSG:; INPUT DMY
  GOSUB 7000
  RETURN
*
**-- DISPLAY OUR RECORD
*
7000 PRINT SCRN(XX):
  IF TITLE#'' THEN
     X.POS = INT(40-LEN(TITLE)/2)
     PRINT @(0,0):'<< ':OCONV(TIME(),'MTH'):@(X.POS,0):TITLE:@(65,0):OCONV(DATE(),'D'):' >>':
  END
7005 IF XX = 1 THEN
       PRINT @(DATA.X<1,1>,DATA.Y<1,1>):
       IF CONVERSIONS<1,1> # '' THEN
         PRINT OCONV(KEY,CONVERSIONS<1,1>) FORMAT<1,1>
       END ELSE PRINT KEY FORMAT<1,1>
     END
  PAINT=''
  IF PAGING = 'Y' THEN PAINT=PAINT: @(69,1):'PAGE :':PAGE.NO'R#3'
  FOR IXZ = 2 TO NO.OF.PROMPTS; *** LOOP THRU FIELDS
    IF SCREEN.NAME<1,IXZ> # SCREEN.NAMES<1,XX> THEN GOTO 7010
    COUNTYXZ = COUNT(DATA.X<1,IXZ>,SVM)+1
    ASSOC.X=NO.OF.ASSOC<1,IXZ> + IXZ
    MV.SV.1=MV.SV<1,IXZ>
    FOR XYZ = 1 TO COUNTYXZ;   *** LOOP THRU VALUE POSITIONS
      FOR XYZ.1 = IXZ TO ASSOC.X;  *** LOOP THRU ASSOCIATED FIELDS
        PAINT=PAINT: @(DATA.X<1,XYZ.1,XYZ>,DATA.Y<1,XYZ.1,XYZ>)
        IF MV.SV.1 = 'M' THEN
          IF XYZ.1=IXZ AND PRNT.NUMBERS THEN PAINT=PAINT: BS.5: XYZ+X-1'R#3':') '
        END
        IF PAGING='Y' THEN ZQ=PAGE.NO;ZQ1=XYZ ELSE ZQ=XYZ; ZQ1=1
        ITM2 = RECORD<FIELDS<1,XYZ.1>,ZQ,ZQ1>
        IF ITM2# '' THEN
          IF CONVERSIONS<1,XYZ.1>#'' THEN ITM2 = OCONV(ITM2,CONVERSIONS<1,XYZ.1>)
          PAINT=PAINT: ITM2 FORMAT<1,XYZ.1>
        END ELSE
          PAINT=PAINT: STR(' ',MAX.LNGTH<1,XYZ.1>)
        END
      NEXT XYZ.1
    NEXT XYZ
*   IXZ=XYZ.1-1;  **-- FOR OTHER THAN INFORMATION MACHINES
    IXZ = XYZ.1
7010 NEXT IXZ
    PRINT PAINT:; PAINT=''
  RETURN
*
**-- EDIT CHECKING TYPE STUFF....
*
8000*
**-- MAX/MIN LENGTH LOGIC
  LNGTH = LEN(ANS)
  IF LNGTH > MX.LNGTH-1 OR LNGTH < MIN.LNGTH<1,Z> THEN
    ERROR = 'ENTRY MUST BE BETWEEN ':MIN.LNGTH<1,Z>:' AND ':MAX.LNGTH<1,Z>:' CHARACTERS LONG'
    GOSUB 9000; GOTO 8010;  **** ERROR ROUTINE
  END
**-- CONVERSION LOGIC
  IF CNV # '' THEN
    IF NUM(ANS) THEN IF ANS = 0 THEN GOTO 8007
    IF (ICONV(ANS,CNV)='' OR ICONV(ANS,CNV)=ANS) OR (CNV[1,2]='MR' AND NOT(NUM(ANS))) THEN
      ERROR = 'INVALID ENTRY... RETRY'
      GOSUB 9000; GOTO 8010; *** ERROR ROUTINE
    END
  END
**-- MATCH PATTERN LOGIC
8007*
  IF MCTH # '' THEN
    COUNTZZ = COUNT(MCTH,'!')+(MCTH#'')
    PASSED = 0
    FOR ZZ = 1 TO COUNTZZ
      MCH = FIELD(MCTH,'!',ZZ)
      IF (ANS MATCHES MCH) THEN PASSED = 1; ZZ = COUNTZZ
    NEXT ZZ
    IF NOT(PASSED) THEN
      ERROR = 'ENTRY DOES NOT MEET REQUIRED FORMAT'
      GOSUB 9000; GOTO 8010; *** ERROR ROUTINE
    END
  END
**-- TRANSLATION LOGIC
  IF TRANSLATES<1,Z> # '' THEN
    TRNSL = TRANSLATES<1,Z>
    T.FILE = FIELD(TRNSL,',',1)
    T.ADD = FIELD(TRNSL,',',2)
    T.KEY = FIELD(T.ADD,':',1):ANS:FIELD(T.ADD,':',2) ; *** PREFIX,SUFFIX
    MUST.EXIST = FIELD(TRNSL,',',3)
    DISPLAY.FLAG = FIELD(TRNSL,',',4)
    T.FLD = FIELD(TRNSL,',',5)
    OPEN '',T.FILE TO F.TFILE ELSE
      PRINT 'UNABLE TO OPEN THE ':T.FILE:' FILE'; STOP
    END
    READ T.REC FROM F.TFILE, T.KEY ELSE
      T.REC = ''
**-- CROSS REFERENCE SEARCH
      IF XREFED<1,Z>#'' THEN
        OPEN '',T.FILE:'.XREF' TO F.XREF ELSE
          ERROR = 'UNABLE TO OPEN THE "':T.FILE:'.XREF" FILE'
          GOSUB 9000; GOTO 8010
        END
        XREF.KEY = FIELD(ANS,' ',1)
        READ XREF.DATA FROM F.XREF, XREF.KEY ELSE XREF.DATA = ''
        COUNTZZ = COUNT(ANS,' ')+(ANS#'')-1
        COMMON.WORDS = ''
        FOR ZZ = 2 TO COUNTZZ
          XREF.KEY = FIELD(ANS,' ',ZZ)
          READ XREF.DATA.1 FROM F.XREF, XREF.KEY ELSE XREF.DATA.1=''
          COUNT.1 = COUNT(XREF.DATA<1>,VM)+(XREF.DATA<1>#'')
          FOR ZZZ = 1 TO COUNT.1
*           LOCATE(XREF.DATA<1,ZZZ>,XREF.DATA.1,1,0;XZZ) THEN COMMON.WORDS<1,-1> = XREF.DATA<1,ZZZ>
            TEST = 1
            LOCATE XREF.DATA<1,ZZZ> IN XREF.DATA.1<1,1> SETTING XZZ ELSE TEST = 0
             IF TEST THEN
                  COMMON.WORDS<1,-1> = XREF.DATA<1,ZZZ>
             END
          NEXT ZZZ
          IF COUNT.1 > 0 THEN XREF.DATA=COMMON.WORDS
          COMMON.WORDS = ''
        NEXT ZZ
        COUNTZZ = COUNT(XREF.DATA<1>,VM)+(XREF.DATA<1>#'')
        HLP=''
        FOR ZZ = 1 TO COUNTZZ
          READ T.REC FROM F.TFILE, XREF.DATA<1,ZZ> ELSE T.REC=''
          HLP<-1> = ZZ'R#3':')':XREF.DATA<1,ZZ>'L#15':'  --  ':T.REC<XREFED<1,Z>>'L#40'
        NEXT ZZ
        IF COUNTZZ = 0 THEN
          ERROR = 'ENTRY DOES NOT EXIST ON THE ':T.FILE:' FILE'
          GOSUB 9000; GOTO 8010
        END
        PRINT @(-1):@(36,0):'* CROSS REFENENCE *'
        XREF.FLAG = 1
        GOSUB 6010
        XREF.FLAG = 0
        ERROR = 'XXX'
**-- IF USER SELECTED ONE FROM LIST THEN AUTO ENTER THAT SELECTION
        IF DMY#'' THEN
          IF NUM(DMY) THEN
            IF DMY >0 AND DMY <= COUNTZZ THEN DATA XREF.DATA<1,DMY>
          END
        END
        GOTO 8010
      END
      IF MUST.EXIST THEN
        ERROR = 'ENTRY DOES NOT EXIST ON THE ':T.FILE:' FILE'
        GOSUB 9000; GOTO 8010;  *** ERROR ROUTINE
      END
    END
    IF DISPLAY.FLAG THEN
      DMY.POS = 40-LEN(T.REC<T.FLD>)/2
      PRINT @(0,23):@(-4):@(DMY.POS,23):T.REC<T.FLD>:
    END
  END
8010*
  RETURN
*
**-- ERROR ROUTINE
*
9000 ER.X.POS = 40 - LEN(ERROR)/2
  PRINT @(0,22):@(-4):@(ER.X.POS,22):ERROR:; INPUT DMY
  PRINT @(0,22):@(-4):
  RETURN
  END