*****************************************************************************
*
*	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