DC.CREATE.DICT.SUBR

SUBROUTINE DC.CREATE.DICT.SUBR(INPUT.PARMS, MODE, RESPONSE)
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Name:     DC.CREATE.DICT.SUBR
* Type:     Subroutine
* Author:   dreller
* Date:     Apr 18, 2020
* Git:      mvDevCore
* System:   openQM 3.4.18
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* Create dict items.  Sub for DC.CREATE.DICT.
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* The input parameters variables should be a MV variable containing
* the following:
*
*   MV#     Description
*   ---     ---------------------------------------------------------
*   1       File in which the DICT item will be created.
*   2       DICT Type.  Valid types are: D, S, A, I, X, PH.
*   3       Attribute Number (for D, A, S).
*   4       Justification/Alignment (L, R, T).
*   5       Width (number from 1 to 100).
*   6       Conversion (MCU, D2, etc.)
*   7       Attribute Name.
*   8       Column title.
*   9       Short description (non-mandatory).
*  10       Formula (Types S and I), Data (Type X), Phrase (Type PH).
*  11       Multivalue flag:  M or S.
*  12       Association with other attributes.
*
* Modes:    "ADD" or empty: Add mode. Skip items that already exists.
*           "UPD": Add if don't exists; Delete/Add if already exists.
*
* The followings are the possible RESPONSE returned by the subroutine
* Always try to get along with ERR.H from SYSCOM.
*
*   Response    Details
*   ----------- -----------------------------------------------------
*   0           Item created.
*   3           ER$ICOMP    I-type compilation error
*   3003        ER$FNF      File not found
*   3009        ER$VNF      VOC file record not F type
*   3034        ER$BAD.DICT Bad dictionary entry
*   6032        ER$EXISTS   Item already exists
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
$INCLUDE DC.INC.H
$INCLUDE SYSCOM ERR.H

CREATE.MODE = @TRUE  
UPDATE.MODE = @FALSE 
    IF MODE = "UPD" THEN 
        CREATE.MODE = @FALSE 
        UPDATE.MODE = @TRUE
    END

* 0) Split DICT attributes from INPUT.PARMS for further checks.
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    IN.FILE     =   INPUT.PARMS<DC$DICT.FILE>
    IN.TYPE     =   INPUT.PARMS<DC$DICT.TYPE>
    IN.NUMBER   =   INPUT.PARMS<DC$DICT.NUMBER>
    IN.ALIGN    =   INPUT.PARMS<DC$DICT.ALIGN>
    IN.WIDTH    =   INPUT.PARMS<DC$DICT.WIDTH>
    IN.OCONV    =   INPUT.PARMS<DC$DICT.OCONV>
    IN.NAME     =   INPUT.PARMS<DC$DICT.NAME>
    IN.TITLE    =   INPUT.PARMS<DC$DICT.TITLE>
    IN.DESC     =   INPUT.PARMS<DC$DICT.DESC>
    IN.FORMULA  =   INPUT.PARMS<DC$DICT.FORMULA>
    IN.MV       =   INPUT.PARMS<DC$DICT.MV>
    IN.ASSOC    =   INPUT.PARMS<DC$DICT.ASSOC>

* 1) Target file.
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    FOUND.FLAG  = @FALSE  
    FILE.TYPE = TRANS("VOC", IN.FILE, 1, "X")
    FOUND.FLAG  = (FILE.TYPE # "")

!-- File does not exists.
    IF NOT(FOUND.FLAG) THEN 
        RESPONSE = ER$FNF 
        RETURN 
    END 

!-- Target file is not F-Type.
    IF FILE.TYPE[1,1] # "F" THEN 
        RESPONSE = ER$VNF 
        RETURN  
    END

* 2) Check if item already exists
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    EXIST.FLAG = @FALSE
    CHECK.VALUE = TRANS("DICT ":IN.FILE, IN.NAME, 1, "X")
    EXIST.FLAG = (CHECK.VALUE # "")

    IF EXIST.FLAG AND CREATE.MODE THEN 
        RESPONSE = ER$EXISTS 
        RETURN
    END

* 3) Dictionary type
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

!-- Identify the type to create.

    VALID.FLAG  = @FALSE
    VALID.TYPES = "D":@VM:"A":@VM:"S":@VM:"I":@VM:"X":@VM:"PH"
    TEMP.NDX = 0

    LOCATE(IN.TYPE, VALID.TYPES, 1;TEMP.NDX) ELSE TEMP.NDX = 0
    IF TEMP.NDX = 0 THEN 
        RESPONSE = ER$BAD.DICT  
        RETURN
    END


* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


* Build DICT record
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

DICT.ITEM = ""

DICT.ITEM<1> = IN.TYPE 
IF IN.DESC # "" THEN 
    DICT.ITEM<1> = IN.TYPE:" ":IN.DESC 
END

!-- X and PH 
    IF IN.TYPE = "X" OR IN.TYPE = "PH" THEN  
        DICT.ITEM<2> = IN.FORMULA
    GOTO 500
    END

!-- I-Descriptor 
    IF IN.TYPE = "I" THEN 
        DICT.ITEM<2> = IN.FORMULA
        DICT.ITEM<3> = IN.OCONV 
        DICT.ITEM<4> = IN.TITLE 
        DICT.ITEM<5> = IN.WIDTH:IN.ALIGN
        DICT.ITEM<6> = IN.MV 
        DICT.ITEM<7> = IN.ASSOC
    GOTO 500
    END

!-- D-Type 
    IF IN.TYPE = "D" THEN 
        DICT.ITEM<2> = IN.NUMBER 
        DICT.ITEM<3> = IN.OCONV 
        DICT.ITEM<4> = IN.TITLE 
        DICT.ITEM<5> = IN.WIDTH:IN.ALIGN 
        DICT.ITEM<6> = IN.MV 
        DICT.ITEM<7> = IN.ASSOC
    GOTO 500
    END

!-- A/S-Type 
    IF IN.TYPE = "A" OR IN.TYPE = "S" THEN 
        DICT.ITEM<2> = IN.NUMBER 
        DICT.ITEM<3> = IN.TITLE 
        DICT.ITEM<4> = IN.ASSOC 
        DICT.ITEM<5> = ""
        DICT.ITEM<6> = ""
        DICT.ITEM<7> = IN.OCONV 
        DICT.ITEM<8> = IN.FORMULA
        DICT.ITEM<9> = IN.ALIGN
        DICT.ITEM<10>= IN.WIDTH
    GOTO 500
    END

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 * Write record to DICT file 
 500: 
    OPEN "DICT ":IN.FILE TO DICT.FILE ELSE STOP "CANNOT OPEN DICT!"
    WRITE DICT.ITEM TO DICT.FILE, IN.NAME 
    CLOSE DICT.FILE

    RESPONSE = 0 
    RETURN

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

!---- At this point, something went wrong 
    RESPONSE = ER$FAILED
    RETURN
END