$OPTIONS A
*
* ITEM    LAST UPDATED:09:08:32 05 AUG 1985
*
*
**-- PROGRAM TO CREATE DOCUMENTATION ON IDEA FROM
**-- A CREATE.PROGRAM PROGRAM.
*
  *
*
**-- OPEN OUR FILES
*
  FL = ''
  OPEN '','TEXT' TO F.TEXT ELSE FL = FL : ' TEXT'
  OPEN '','HCSF' TO F.HCSF ELSE FL = FL : ' HCSF'
  OPEN '','HCSD' TO F.HCSD ELSE FL = FL : ' HCSD'
  IF FL # '' THEN
    PRINT 'UNABLE TO OPEN THE FOLLOWING FILES...'
    PRINT '"':FL[2,99]:'"'
    STOP
  END
  POUNDS = STR('#',78)
  PROMPT ''
  FM = CHAR(254); AM = FM; VM = CHAR(253); SVM = CHAR(252)
  PRINT @(-1):'                   IDEA DOCUMENTOR'
10*
  PRINT @(10,10):@(-4):'ENTER TEXT RECORD I.D. :':; INPUT KEY
  IF KEY = '' OR KEY = 'X' THEN PRINT @(-1):; STOP
  READ RECORD FROM F.TEXT, KEY ELSE
    ERROR = 'UNABLE TO READ REQUESTED RECORD FROM THE "TEXT" FILE :'
    GOSUB 9000
    GOTO 10
  END
*
**-- CREATE HCSD RECORD
*
  FOUND = 1
  NO.OF.PROMPTS = COUNT(RECORD<20>,CHAR(253))+(RECORD<20>#'')
  NO.OF.XTRA    = COUNT(RECORD<45>,CHAR(253))+(RECORD<45>#'')
  READ HCSD.REC FROM F.HCSD, KEY ELSE FOUND = 0
  IF FOUND THEN
    ERROR = 'HCSD RECORD EXISTS, ALRIGHT TO OVERRIDE (Y/N): '
    GOSUB 9000
    IF DMY[1,1] # 'Y' THEN GOTO 20
  END
  HCSD.REC = ''
  HCSD.REC<1> = RECORD<1>
  VMC = 0
  FOR I = 1 TO NO.OF.PROMPTS
    VMC = VMC + 1
      HCSD.REC<5,VMC> = RECORD<17,I,1>+1
      HCSD.REC<4,VMC> = RECORD<18,I,1>
      IF I = 1 THEN
         DISPLAY = RECORD<7,I>
       END ELSE
         DISPLAY = (VMC-1)'R#3':'.':RECORD<7,I>
       END
       STRNR = STR('.',RECORD<15,I,1>+1-RECORD<17,I>-LEN(RECORD<7,I>)-5)
       HCSD.REC<9,VMC>=DISPLAY:STRNR:POUNDS[1,RECORD<12,I>]
       HCSD.REC<18,VMC,-1> = 'Minimum number of characters allowed is "':RECORD<21,I>:'"'
       HCSD.REC<18,VMC,-1> = 'Maximum number of characters allowed is "':RECORD<12,I>:'"'
       IF RECORD<8,I>[1,1] # 'Y' THEN REQ = 'IS NOT' ELSE REQ = 'IS'
       HCSD.REC<18,VMC,-1> = 'This entry ':REQ:' required.'
       IF RECORD<24,I> # '' THEN
         HCSD.REC<18,VMC,-1> = 'This entry must pass a ':RECORD<24,I>:' conversion.'
       END
       IF RECORD<11,I> # '' THEN
          HCSD.REC<18,VMC,-1> = 'This entry must match one of these patterns "':RECORD<11,I>:'"'
        END
        HCSD.REC<18,VMC,-1> = RECORD<22,I>
       COUNTY = COUNT(RECORD<15,I>,CHAR(252))+1
       FOR X = 1 TO COUNTY
         IF X > 1 THEN VMC = VMC + 1
          HCSD.REC<7,VMC> = 'E'
          HCSD.REC<14,VMC> = RECORD<24,I>
          HCSD.REC<19,VMC> = RECORD<5,I>
          HCSD.REC<10,VMC>=1
          HCSD.REC<13,VMC> = RECORD<8,I>
          HCSD.REC<6,VMC> = RECORD<20,I>
          IF X > 1 THEN
             HCSD.REC<9,VMC> = POUNDS[1,RECORD<12,I>]
             HCSD.REC<5,VMC> = RECORD<15,I,X>+1
             HCSD.REC<4,VMC> = RECORD<16,I,X>
          END
       NEXT X
   NEXT I
   FOR I = 1 TO  NO.OF.XTRA
      HCSD.REC<5,-1>=RECORD<13,I>
      HCSD.REC<4,-1>=RECORD<14,I>
      HCSD.REC<9,-1>=RECORD<45,I>
      HCSD.REC<10,-1>='1'
      HCSD.REC<7,-1> = 'D'
   NEXT I
   WRITE HCSD.REC ON F.HCSD, KEY
*
**-- UPDATE HCSF RECORD
*
   FOUND = 1
   READ HCSF.REC FROM F.HCSF, KEY ELSE FOUND = 0
   IF NOT(FOUND) THEN HCSF.REC = ''
   IF FOUND THEN
      PRINT @(0,22):@(-4):'RECORD ALREADY EXISTS ON THE "HCSF" FILE OVERWRITE (Y/N):':; INPUT ANS:
      PRINT @(0,22):@(-4):
      IF ANS[1,1] # 'Y' THEN GOTO 10
      HCSF.REC = ''
   END
   HCSF.REC<2> = RECORD<99>
   CNTR = 1
   HCSF.REC<15,1> = 'PURPOSE     : To update the ':RECORD<1>:' file.'
   HCSF.REC<15,-1>= ' '
   DMY= 'FILES USED  : ':RECORD<1>
   FOR Z = 1 TO NO.OF.PROMPTS
      IF RECORD<22,Z> # '' THEN
         DMY = DMY : ',':FIELD(RECORD<22,Z>,',',1)
      END
   NEXT Z
   HCSF.REC<15,-1> = DMY
   HCSF.REC<15,-1> = ' '
   HCSF.REC<15,-1> = 'PROCESSING....'
   FOR I = 1 TO NO.OF.PROMPTS
      IF RECORD<54,I> # '' THEN
        HCSF.REC<17,-1> = RECORD<7,I>'L#15':':  ':RECORD<54,I,1>
        COUNTZ = COUNT(RECORD<54,I>,SVM)+1
        FOR BEZ = 2 TO COUNTZ
          HCSF.REC<17,-1> = SPACE(18):RECORD<54,I,BEZ>
        NEXT BEZ
      END
       HCSF.REC<15,-1> = RECORD<7,I>'L#15':' : ': 'Minimum number of characters allowed is "':RECORD<21,I>:'"'
       HCSF.REC<15,-1> = SPACE(18): 'Maximum number of characters allowed is "':RECORD<12,I>:'"'
       IF RECORD<8,I>[1,1] # 'Y' THEN REQ = 'IS NOT' ELSE REQ = 'IS'
       HCSF.REC<15,-1> = SPACE(18): 'This entry ':REQ:' required.'
       HCSF.REC<15,-1> = SPACE(18): 'This entry will go into field ':RECORD<20,I>:' of the process record.'
       IF RECORD<24,I> # '' THEN
         HCSF.REC<15,-1> = SPACE(18): 'This entry must pass a ':RECORD<24,I>:' conversion.'
       END
       IF RECORD<11,I> # '' THEN
          HCSF.REC<15,-1> = SPACE(18): 'This entry must match one of these patterns "':RECORD<11,I>:'"'
       END
        IF RECORD<22,I> # '' THEN
           T.FILE = FIELD(RECORD<22,I>,',',1)
           PREFIX = FIELD(FIELD(RECORD<22,I>,',',2),':',1)
           SUFFIX = FIELD(FIELD(RECORD<22,I>,',',2),':',2)
           MUST.EXIST = FIELD(RECORD<22,I>,',',3)
           T.DISP  = FIELD(RECORD<22,I>,',',4)
           T.FIELD = FIELD(RECORD<22,I>,',',5)
           HCSF.REC<15,-1> = SPACE(18):'Read the ': T.FILE:' file.'
           IF PREFIX # '' THEN
              HCSF.REC<15,-1> = SPACE(18):'Using the users entry prefixed by "':PREFIX:'".'
           END
           IF SUFFIX # '' THEN
              HCSF.REC<15,-1> = SPACE(18):'Using the users entry suffixed by "':SUFFIX:'".'
           END
           IF PREFIX = '' AND SUFFIX = '' THEN
              HCSF.REC<15,-1> = SPACE(18): 'Using the users entry.'
           END
           IF MUST.EXIST THEN
              HCSF.REC<15,-1> = SPACE(18): 'The record must exist on the ':T.FILE:' file or reprompt.'
           END
           IF T.DISP THEN
              HCSF.REC<15,-1> = SPACE(18):'Display field "':T.FIELD:'" of the record read.'
           END
        END
   NEXT I
   WRITE HCSF.REC ON F.HCSF, KEY
*
**-- END
*
20*
   PRINT @(0,22):@(-4):'DONE... PRESS <RETURN> TO CONTINUE :':; INPUT ANS:
   PRINT @(0,22):@(-4):
   GOTO 10
*
**-- ERROR ROUTINE
*
9000*
  PRINT @(0,22):@(-4):ERROR:; INPUT DMY:
  PRINT @(0,22):@(-4):
  RETURN
END