tldm-universe/Ardent/UV/APP.PROGS/COMPMAINT.SUB
2024-09-09 17:51:08 -04:00

219 lines
6.8 KiB
Plaintext
Executable File

SUBROUTINE COMPILE.MAINT.FILE.SUB(PRECOMP.FILENAME,PRECOMP.XREF.REC,PRECOMP.XREF.ID,RESULTS)
*******************************************************************************
*
* Server subroutine for PICK Account Conversion Toolkit
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Vmark Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Vmark Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
************************************************************************
*
* DESCRIPTION:
*
************************************************************************
$INCLUDE UNIVERSE.INCLUDE PACTERR.H
EQU AM TO CHAR(254)
EQU VM TO CHAR(253)
EQU TRUE TO 1
EQU FALSE TO 0
*
RESULTS = ''
PROMPT ''
PROMPT.LINE = @(0,22):@(-4):@(0,22):@(0,23):@(-4):@(0,22)
OPENPATH PRECOMP.FILENAME TO F.PRECOMP ELSE
RESULTS = EADM.CANTOPENPRECOMP
RETURN
END
* Read the record
PRINT @(-1):
TOKEN.NAME = PRECOMP.XREF.ID
NEW.REC = FALSE
READU PRECOMP.XREF.REC FROM F.PRECOMP,TOKEN.NAME ELSE
PRECOMP.XREF.REC = ''
NEW.REC = TRUE
END
IF NOT(NEW.REC) THEN GOSUB 100 ; * Build display list
FIRST.PASS = TRUE
COMPLETE = FALSE
IF NEW.REC THEN
* The record is new so we will go through the addition procudure
* The first step is to enter the conditions (if any)
* If this is a multi line replacement then we will leave line one
* empty.
LOOP
TEXT = "Enter the conditions. (Space for empty line, 'X' continue)."
GOSUB 10
CONDITION = RESP
IF FIRST.PASS AND RESP = ' ' THEN COMPLETE = TRUE
IF OCONV(TRIM(RESP),'MCU') = 'X' THEN COMPLETE = TRUE
UNTIL COMPLETE DO
CONDITION = TRIM(CONDITION)
IF CONDITION = " " THEN CONDITION = ''
IF FIRST.PASS AND CONDITION = "X" THEN
PRINT @(-1):
STOP
END ELSE
IF CONDITION # "X" THEN
PRECOMP.XREF.REC<1,-1> = CONDITION
END
END
FIRST.PASS = FALSE
GOSUB 100 ; * Build display list
REPEAT
VALID.RESP = FALSE
IF PRECOMP.XREF.REC<1> = '' THEN
* We left attribute one blank so this is a multi line replacement
* Prompt to enter the result varable.
GOSUB 100 ; * Go ahead and display the record.
LOOP
TEXT = "Enter the result varable. ('X' to continue)"
GOSUB 10
RESULTS = RESP
IF RESULTS <> 'X' AND RESULTS <> "" THEN VALID.RESP = TRUE
UNTIL VALID.RESP DO REPEAT
IF RESULTS <> "X" THEN
PRECOMP.XREF.REC<2> = RESULTS
END
GOSUB 100
* Now we enter the statements to replace the token
LOOP
TEXT = "Enter the statement(s) to replace this token (Empty line to continue)."
GOSUB 10
STATEMENTS = RESP
UNTIL STATEMENTS = "" DO
PRECOMP.XREF.REC<3,-1> = STATEMENTS
GOSUB 100
REPEAT
END ELSE
NUM.OF.CONDITIONS = DCOUNT(PRECOMP.XREF.REC<1>,VM)
COMPLETE = FALSE
FOR CONDITION.COUNT = 1 TO NUM.OF.CONDITIONS
LOOP
TEXT = "Enter the statement(s) to replace condition ":CONDITION.COUNT:" (Empty line to continue)"
GOSUB 10
CONDITION = RESP
UNTIL OCONV(TRIM(RESP),'MCU') = '' DO
PRECOMP.XREF.REC<CONDITION.COUNT+2,-1> = CONDITION
GOSUB 100
REPEAT
NEXT CONDITION.COUNT
END
GOSUB 100 ; * Display the line
GOSUB 200
END ELSE
GOSUB 200
END
WRITE PRECOMP.XREF.REC ON F.PRECOMP,TOKEN.NAME
RETURN
STOP
10 * Input RESP
PRINT PROMPT.LINE:TEXT:
PRINT @(0,23):
INPUT RESP:
RETURN
*
100 * Display a line
YPOS = 4 ; XPOS = 1
PRINT @(-1):@(1,2):"Token: ":TOKEN.NAME
NUM.OF.LINES = DCOUNT(PRECOMP.XREF.REC,@AM)
FOR A = 1 TO NUM.OF.LINES
NUM.OF.SUBVALUES = DCOUNT(PRECOMP.XREF.REC<A>,@VM)
IF A < 3 AND NUM.OF.SUBVALUES = 0 THEN NUM.OF.SUBVALUES = 1
FOR B = 1 TO NUM.OF.SUBVALUES
IF PRECOMP.XREF.REC<A> = "" THEN
NUM.VALUE = A
END ELSE
NUM.VALUE = A:".":B
END
IF LEN(PRECOMP.XREF.REC<A,B>) > 40 THEN
LINE = @(XPOS,YPOS):NUM.VALUE "L#5":PRECOMP.XREF.REC<A,B> "L#39":">"
END ELSE
LINE =@(XPOS,YPOS):NUM.VALUE "L#5":PRECOMP.XREF.REC<A,B> "L#40"
END
IF A < 3 THEN
PRINT @(XPOS,YPOS):LINE:
IF XPOS > 20 THEN XPOS = 4 ; YPOS = 46
YPOS = YPOS + 1
END ELSE
IF PRECOMP.XREF.REC<A,B> # "" THEN
PRINT @(XPOS,YPOS):LINE:
YPOS = YPOS + 1
IF XPOS > 20 THEN XPOS = 4 ; YPOS = 46
END
END
NEXT B
NEXT A
RETURN
*
200 * Edit a line
*
* This will edit the lines that have been entered previously.
* We will allow the user to go through this as much
* As they like to do so. Then when they exit all will be saved.
LOOP
TEXT = "Enter the line to change XX or XX.XX ('A' to add a line. , 'X' to exit)"
GOSUB 10
UNTIL RESP = 'X' DO
IF RESP MATCHES "0N.0N" OR RESP MATCHES "0N" THEN
IF RESP MATCHES "0N.0N" THEN
NUMBER = FIELD(RESP,'.',1)
ITEM = FIELD(RESP,'.',2)
END ELSE
NUMBER = RESP
ITEM = 1
END
* If the line contains a value then we allow a change.
IF PRECOMP.XREF.REC<NUMBER,ITEM> # "" THEN
TEXT = "Enter the new value for line ":NUMBER:".":ITEM:" Space to delete line 'D' to display more information"
GOSUB 10
NEW.VALUE = RESP
IF NEW.VALUE = " " THEN
PRECOMP.XREF.REC = DELETE(PRECOMP.XREF.REC,NUMBER,ITEM)
GOSUB 100
END ELSE
IF OCONV(NEW.VALUE,'MCU') = 'D' THEN
PRINT @(0,22):@(-4):@(0,22):"Press <RETURN> to continue. ":
PRINT @(0,23):@(-4):@(0,23):PRECOMP.XREF.REC<NUMBER,ITEM> "L#79":
INPUT XXX:
END ELSE
PRECOMP.XREF.REC<NUMBER,ITEM> = NEW.VALUE
GOSUB 100
END
END
END ELSE
TEXT = "There is no such item. Press <ENTER> to continue."
GOSUB 10
END
END ELSE
IF RESP = 'A' THEN
LOOP
IF PRECOMP.XREF.REC<2> = "" THEN
TEXT = "Enter condition to add. 'X' exits"
END ELSE
TEXT = "Enter the statement to add. 'X' exits"
END
GOSUB 10
UNTIL OCONV(RESP,'MCU') = 'X' DO
IF PRECOMP.XREF.REC<2> = "" THEN
PRECOMP.XREF.REC<1,-1> = RESP
TEXT = "Enter the statement for this condition."
PRECOMP.XREF.REC<-1> = RESP
GOSUB 10
END ELSE
PRECOMP.XREF.REC<3,-1> = RESP
END
REPEAT
END
END
REPEAT
RETURN
END