303 lines
11 KiB
Plaintext
303 lines
11 KiB
Plaintext
|
*****************************************************************************
|
||
|
|
*
|
||
|
|
* Convert Dictionaries from Pick to Uni*Verse Format
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 06/04/96 18438 JC Port to NT
|
||
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* This program was produced in part by SCREENGEN, a proprietary program of
|
||
|
|
* Infocel, Inc., P.O. Box 18305, Raleigh, N.C. 27609
|
||
|
|
*
|
||
|
|
*****************************************************************************
|
||
|
|
*
|
||
|
|
*
|
||
|
|
*
|
||
|
|
*
|
||
|
|
$OPTIONS A
|
||
|
|
CLEAR COMMON
|
||
|
|
COMMON CLR, CL, CL.ERR, PROMPT, ERR, HELP, HELP3, STD.HELP, MV.HELP,
|
||
|
|
ERR.MSG, MSG1, MSG2, MSG3, MSG4, MSG5,
|
||
|
|
ID, Q, NEW.ITEM, REC(100)
|
||
|
|
*
|
||
|
|
*
|
||
|
|
*
|
||
|
|
CLR = @(-1)
|
||
|
|
CL = @(-4)
|
||
|
|
CL.ERR = @(0,23):CL
|
||
|
|
EQU BELL TO CHAR(7)
|
||
|
|
PROMPT=@(0,22):CL:@(0,21):CL
|
||
|
|
PROMPT ""
|
||
|
|
*
|
||
|
|
EQU TRUE TO 1, FALSE TO 0
|
||
|
|
*
|
||
|
|
ERR = CL.ERR:BELL
|
||
|
|
HELP = CL.ERR
|
||
|
|
HELP3 = CL.ERR:PROMPT
|
||
|
|
*
|
||
|
|
STD.HELP=HELP3
|
||
|
|
STD.HELP=STD.HELP:'Enter "?" for help, "^" to back up to previous prompt, "XX" to cancel input,'
|
||
|
|
STD.HELP=STD.HELP:@(0,22):' or data value requested by prompt. Data will be edited and an error'
|
||
|
|
STD.HELP=STD.HELP:@(0,23):' will appear if data are invalid. --- Enter <CR>'
|
||
|
|
MV.HELP=HELP3
|
||
|
|
MV.HELP=MV.HELP:'Enter "?" for help, "^" to back up to previous prompt, "XX" to cancel input,'
|
||
|
|
MV.HELP=MV.HELP:@(0,22):' "+" to display next value group, "DE" to delete value, "I" to insert value,'
|
||
|
|
MV.HELP=MV.HELP:@(0,23):' "/" to end value input, or data value requested. --- Enter <CR>'
|
||
|
|
ERR.MSG=ERR:"Your response does not pass the edits. Enter a new response."
|
||
|
|
MSG1=ERR:'Unable to open the file - '
|
||
|
|
MSG2=ERR:'A response is required.'
|
||
|
|
MSG3=ERR:'Response is too long.'
|
||
|
|
MSG4=ERR:'Numeric input required.'
|
||
|
|
MSG5=ERR:'Response is not in the code file.'
|
||
|
|
*
|
||
|
|
EQU AM TO CHAR(254)
|
||
|
|
EQU VM TO CHAR(253)
|
||
|
|
EQU SVM TO CHAR(252)
|
||
|
|
EQU NO.DATA TO CHAR(0)
|
||
|
|
*
|
||
|
|
*
|
||
|
|
MV3=1 ;* CRITERIA
|
||
|
|
COL3=2:AM:2:AM:2:AM:2:AM:2
|
||
|
|
LIN3=10:AM:11:AM:12:AM:13:AM:14
|
||
|
|
*
|
||
|
|
*
|
||
|
|
*
|
||
|
|
EQU FOREGROUND.BACKGROUND TO REC(1)
|
||
|
|
EQU PRINTED.LISTING TO REC(2)
|
||
|
|
EQU CRITERIA TO REC(3)
|
||
|
|
*
|
||
|
|
*
|
||
|
|
SSA07=CLR ;* Convert Dictionaries from Pick to Uni*Verse Format
|
||
|
|
SSA07=SSA07:@(0,0):"Account Conversion":SPACE(44):" CONV.DICTS"
|
||
|
|
SSA07=SSA07:@(13,1):"Convert Dictionaries from Pick to Uni*Verse Format"
|
||
|
|
SSA07=SSA07:@(0,2):STR("-",79)
|
||
|
|
SSA07=SSA07:@(0,5):"1. Foreground/background:"
|
||
|
|
SSA07=SSA07:@(0,7):"2. Printed listing:"
|
||
|
|
SSA07=SSA07:@(0,9):"3. Additional selection criteria:"
|
||
|
|
SSA07=SSA07:@(0,10):"3.1"
|
||
|
|
SSA07=SSA07:@(0,11):"3.2"
|
||
|
|
SSA07=SSA07:@(0,12):"3.3"
|
||
|
|
SSA07=SSA07:@(0,13):"3.4"
|
||
|
|
SSA07=SSA07:@(0,14):"3.5"
|
||
|
|
SSA07=SSA07:@(0,19):STR("-",79)
|
||
|
|
*
|
||
|
|
CLR.SSA07=@(0,0):@(26,5):CL:@(26,7):CL
|
||
|
|
CLR.SSA07=CLR.SSA07:@(2,10):1:CL:@(2,11):2"L#78":@(2,12):3"L#78":@(2,13):4"L#78":@(1,14):".":5"L#79"
|
||
|
|
*
|
||
|
|
2 OPEN '','VOC' TO FVVOC ELSE
|
||
|
|
PRINT MSG1:'VOC':
|
||
|
|
INPUT Q: ; PRINT CL.ERR: ; GOTO 2
|
||
|
|
END
|
||
|
|
READV SOURCE.MACHINE FROM FVVOC, "RELLEVEL", 4 ELSE SOURCE.MACHINE = "O"
|
||
|
|
SOURCE.MACHINE = SOURCE.MACHINE[ 1, 1 ]
|
||
|
|
IF SOURCE.MACHINE <> "M" THEN SOURCE.MACHINE = "O"
|
||
|
|
*
|
||
|
|
************* ENTER RECORD KEY ***************
|
||
|
|
*
|
||
|
|
30 PRINT SSA07: ;* Convert Dictionaries from Pick to Uni*Verse Format
|
||
|
|
MAT REC=""; NEW.ITEM=TRUE ; GOSUB 50 ;*** UPDATE RECORD
|
||
|
|
STOP
|
||
|
|
50 ***** UPDATE SUBROUTINE *****
|
||
|
|
IF NEW.ITEM THEN ;***** PROMPT FOR INPUT OF NEW REC
|
||
|
|
MV=0
|
||
|
|
FOR Z = 1 TO 3
|
||
|
|
Q=NO.DATA
|
||
|
|
ON Z GOSUB 100,200,300
|
||
|
|
IF FOREGROUND.BACKGROUND = "F" THEN
|
||
|
|
NEW.ITEM = FALSE
|
||
|
|
GOTO 70
|
||
|
|
END
|
||
|
|
IF Q="^" THEN IF MV>1 THEN MV=MV-2 ; Z=Z-1 ELSE IF Z<=1 THEN GOTO 9999 ELSE Z=Z-2
|
||
|
|
IF Q="XX" THEN GOTO 9999
|
||
|
|
NEXT Z
|
||
|
|
NEW.ITEM=FALSE
|
||
|
|
END ELSE MV=0 ; Q=""; GOSUB 88 ;*** PRINT SCREEN AND DATA
|
||
|
|
*
|
||
|
|
*######################### PRIMARY CONTROL LOOP #########################
|
||
|
|
LOOP
|
||
|
|
70 PRINT PROMPT:"Enter save(S), cancel(XX), delete(DE), or field # to change: ":
|
||
|
|
INPUT Q ; PRINT CL.ERR:PROMPT:
|
||
|
|
UNTIL Q="S" OR Q="s" OR Q="." DO
|
||
|
|
IF Q="+" THEN Q="3,+"
|
||
|
|
Z=FIELD(Q,",",1)
|
||
|
|
BEGIN CASE
|
||
|
|
CASE Z>=1 AND Z<=3.99 AND NUM(Z)
|
||
|
|
Q=Q[COL2()+1,999]
|
||
|
|
IF Q="" THEN Q=NO.DATA
|
||
|
|
ON Z GOSUB 100,200,300
|
||
|
|
MV=0
|
||
|
|
CASE Q="XX" OR Q="xx" or Q="DE" or Q="de"
|
||
|
|
GOTO 9999
|
||
|
|
CASE Q="R" OR Q="r" OR Q="^^"; PRINT SSA07: ; GOSUB 88 ;* REFRESH SCREEN
|
||
|
|
CASE 1 ; PRINT ERR:'Enter one of the requested commands.':
|
||
|
|
END CASE
|
||
|
|
REPEAT
|
||
|
|
IF FOREGROUND.BACKGROUND = "F" THEN
|
||
|
|
EXECUTE "DC"
|
||
|
|
STOP
|
||
|
|
END ELSE
|
||
|
|
PARA = "PA"
|
||
|
|
PARA< 2 > = "SSELECT VOC WITH F1 LIKE F... AND WITH F3 UNLIKE .../... "
|
||
|
|
PARA< 2 > = PARA< 2 > : 'AND WITH F3 UNLIKE "...\..."'
|
||
|
|
PARA< 2 > = PARA< 2 > : 'AND WITH F3 UNLIKE "&..." AND WITH F3 UNLIKE VOC... '
|
||
|
|
NBR.LINES = DCOUNT( CRITERIA, @VM )
|
||
|
|
FOR I = 1 TO NBR.LINES
|
||
|
|
PARA< 2 > = PARA< 2 > : CRITERIA< 1, NBR.LINES > : " "
|
||
|
|
NEXT I
|
||
|
|
PARA< 3 > = "DC -" : PRINTED.LISTING : SOURCE.MACHINE : "P"
|
||
|
|
WRITE PARA ON FVVOC, "CONVERT.DICTS"
|
||
|
|
PRINT PROMPT : "Adding CONVERT.DICTS paragraph to your VOC."
|
||
|
|
EXECUTE "PHANTOM CONVERT.DICTS"
|
||
|
|
PRINT CLR.SSA07:
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
*
|
||
|
|
9999 PRINT CLR.SSA07:PROMPT:
|
||
|
|
RETURN ;********** EXIT UPDATE ROUTINE
|
||
|
|
*
|
||
|
|
88*** REFRESH DATA
|
||
|
|
PRINT @(26,5):FOREGROUND.BACKGROUND "L#10"
|
||
|
|
PRINT @(26,7):PRINTED.LISTING "L#3"
|
||
|
|
GOSUB 360 ; MV=0 ;* DISPLAY CRITERIA
|
||
|
|
Q=NO.DATA
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
*##########################################################################
|
||
|
|
*
|
||
|
|
100 *** ########## FOREGROUND.BACKGROUND
|
||
|
|
IF Q=NO.DATA THEN
|
||
|
|
110 PRINT PROMPT:"Do you want to run the conversions in the Foreground or Background (F/B)? .":
|
||
|
|
PRINT @(74,21):
|
||
|
|
INPUT Q,3: ; PRINT CL.ERR:PROMPT:
|
||
|
|
Q = UPCASE( Q )
|
||
|
|
END
|
||
|
|
IF Q="" THEN
|
||
|
|
PRINT ERR:'Response must be: "F" or "B".'[1,78]:
|
||
|
|
GOTO 110
|
||
|
|
END
|
||
|
|
IF Q="?" THEN
|
||
|
|
PRINT STD.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
|
|
GOTO 110
|
||
|
|
END
|
||
|
|
IF Q="^" OR Q="XX" THEN RETURN
|
||
|
|
130 *** EDITS FOR FOREGROUND.BACKGROUND
|
||
|
|
IF Q#"F" AND Q#"B" THEN
|
||
|
|
PRINT ERR:'Response must be: "F" or "B".'[1,78]:
|
||
|
|
GOTO 110
|
||
|
|
END
|
||
|
|
140 *** DISPLAY FOREGROUND.BACKGROUND
|
||
|
|
FOREGROUND.BACKGROUND=Q
|
||
|
|
IF Q="F" THEN Q="Foreground"
|
||
|
|
IF Q="B" THEN Q="Background"
|
||
|
|
PRINT @(26,5):Q "L#10"
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
200 *** ########## PRINTED.LISTING
|
||
|
|
IF Q=NO.DATA THEN
|
||
|
|
210 PRINT PROMPT:"Do you want a listing sent to the printer (Y/N)? .":@(49,21):
|
||
|
|
INPUT Q,3: ; PRINT CL.ERR:PROMPT:
|
||
|
|
Q = UPCASE( Q )
|
||
|
|
END
|
||
|
|
IF Q="" THEN
|
||
|
|
PRINT ERR:"Response must be Yes(Y) or No(N).":
|
||
|
|
GOTO 210
|
||
|
|
END
|
||
|
|
IF Q="?" THEN
|
||
|
|
PRINT STD.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
|
|
GOTO 210
|
||
|
|
END
|
||
|
|
IF Q="^" OR Q="XX" THEN RETURN
|
||
|
|
230 *** EDITS FOR PRINTED.LISTING
|
||
|
|
IF Q#"Y" AND Q#"N" THEN
|
||
|
|
PRINT ERR:"Response must be Yes(Y) or No(N).":
|
||
|
|
GOTO 210
|
||
|
|
END
|
||
|
|
IF LEN(Q)>3 THEN
|
||
|
|
PRINT MSG3:
|
||
|
|
GOTO 210
|
||
|
|
END
|
||
|
|
240 *** DISPLAY PRINTED.LISTING
|
||
|
|
PRINTED.LISTING=Q
|
||
|
|
IF Q="Y" THEN Q="Yes" ELSE Q="No "
|
||
|
|
PRINT @(26,7):Q "L#3"
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
300 *** ########## CRITERIA
|
||
|
|
* MULTIVALUE
|
||
|
|
VALUE.INSERTED=FALSE
|
||
|
|
IF NEW.ITEM THEN MV=MV+1 ELSE
|
||
|
|
MV=FIELD(Z,".",2) ; Z=INT(Z)
|
||
|
|
IF MV<1 THEN
|
||
|
|
IF Q="DE" THEN
|
||
|
|
CRITERIA=""; MV=1 ; GOSUB 360 ;* DELETE FIELD
|
||
|
|
END ELSE IF Q="+" THEN MV=1 ELSE
|
||
|
|
FOR MV=1 TO 99 UNTIL CRITERIA<1,MV>=""; NEXT MV
|
||
|
|
IF MV>MV3+5 THEN GOSUB 360 ;* DISPLAY FIELD
|
||
|
|
END
|
||
|
|
END ELSE IF CRITERIA<1,MV>='' AND Q#'DE' THEN GOTO 300
|
||
|
|
END
|
||
|
|
IF Q=NO.DATA THEN
|
||
|
|
PRINT HELP:"Now reads: SSELECT VOC WITH F1 LIKE F... AND WITH F3 UNLIKE .../... AND WITH F3 UNLIKE ...\...":
|
||
|
|
310 PRINT PROMPT:"Enter any additional SELECTion criteria, line ":MV:":"
|
||
|
|
PRINT @(0,22):STR(".",74):@(0,22):
|
||
|
|
INPUT Q,76: ; PRINT CL.ERR:PROMPT:
|
||
|
|
IF(Q="/" or Q="") AND NOT(VALUE.INSERTED) THEN MV=0 ; RETURN
|
||
|
|
END
|
||
|
|
IF Q="" THEN
|
||
|
|
PRINT MSG2:
|
||
|
|
GOTO 310
|
||
|
|
END
|
||
|
|
IF Q="I" THEN
|
||
|
|
VALUE.INSERTED=TRUE ; CRITERIA=INSERT(CRITERIA,1,MV,0,"")
|
||
|
|
GOSUB 360 ; Q=NO.DATA ; GOTO 310 ;* INSERT MV
|
||
|
|
END
|
||
|
|
IF Q="+" THEN MV=MV3+5 ; GOSUB 360 ; RETURN ;* DISPLAY ONLY
|
||
|
|
IF Q="DE" THEN
|
||
|
|
CRITERIA=DELETE(CRITERIA,1,MV,0)
|
||
|
|
GOSUB 360 ; RETURN ;* DELETE MV
|
||
|
|
END
|
||
|
|
IF Q="?" THEN
|
||
|
|
PRINT HELP:"Now reads: SSELECT VOC WITH F1 LIKE F... AND WITH F3 UNLIKE .../... AND WITH F3 UNLIKE ...\...":
|
||
|
|
GOTO 310
|
||
|
|
END
|
||
|
|
IF Q="^" OR Q="XX" OR Q="/" THEN
|
||
|
|
IF NOT(VALUE.INSERTED) THEN MV=0 ; RETURN ELSE CRITERIA=DELETE(CRITERIA,1,MV,0) ; GOSUB 360 ; MV=0 ; RETURN
|
||
|
|
END
|
||
|
|
330 *** EDITS FOR CRITERIA
|
||
|
|
IF LEN(Q)>74 THEN
|
||
|
|
PRINT MSG3:
|
||
|
|
GOTO 310
|
||
|
|
END
|
||
|
|
340 *** DISPLAY CRITERIA
|
||
|
|
CRITERIA<1,MV>=Q
|
||
|
|
IF MV<MV3 OR MV>MV3+4 THEN GOSUB 360
|
||
|
|
PRINT @(COL3<MOD(MV-1,5)+1>,LIN3<MOD(MV-1,5)+1>):MV"L#3":Q "L#74"
|
||
|
|
IF NEW.ITEM THEN MV=MV+1 ; GOTO 310 ELSE MV=0
|
||
|
|
RETURN
|
||
|
|
360 MV3=5*INT((MV-1)/5)+1 ;* DISPLAY FIELD
|
||
|
|
IF CRITERIA<1,MV3>="" AND Q="+" THEN MV3=1
|
||
|
|
FOR K=MV3 TO MV3+4
|
||
|
|
PRINT @(COL3<MOD(K-1,5)+1>,LIN3<MOD(K-1,5)+1>):K"L#3":CRITERIA<1,K> "L#74":
|
||
|
|
NEXT K
|
||
|
|
PRINT @(COL3<5>-1,LIN3<5>):
|
||
|
|
IF CRITERIA<1,K>#"" THEN PRINT "+" ELSE PRINT "."
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
*
|
||
|
|
*
|
||
|
|
END
|