Monday, June 24, 2019

How to determine if a dictionary item is possibly a code table lookup

How to determine if a dictionary item is possibly a code table lookup I-Type:

This article describes how to use an I-Type to determine all dictionary items that are also code table lookups. Up to now when I want to find any dictionary item that is a code table lookup I visually list the dictionary, looking for any records with field two containing the TRANS() function and the KEY argument equaling the code field in question. For example, SEX is a typical field in a dictionary, containing either "M" or "F" (or some other codes as needed). When programmers or analysts want to output either "Male" or "Female" instead of the code then an I-Type is usually constructed to output the word that describes the code. A sex field (or any other field with just a few possible codes) can simply use an I-Type with simple IF-THEN-ELSE logic. For example:

001: I Output the sex description
002: IF SEX="M" THEN "Male" ELSE IF SEX="F" THEN "Female" ELSE "?"
...

However, many code fields can potentially contain many more values... sometimes in the thousands or tens of thousands of possible values. In these cases an I-Type constructed as follows would be appropriate:

001: I Output the item description
002: TRANS("PARTS.FILE",PART.NUM,DESC,"X")
...

The syntax of the TRANS() function is pretty basic but I'll explain it anyway. Argument one is the table name to perform the lookup on (PARTS.FILE in this case). Argument two is the record ID to be looked up (read). In this case the record ID of the PARTS.FILE table is the same as the PART.NUM field in this file. The third argument (DESC) is the field to return. This can also be hardcoded as an integer, which is the number of the field in the table record to return. Obviously, when using the field name (ex: "DESC") it must exist as a D-Type dictionary item in the table. Finally, the fourth argument dictates what to return if the record doesn't exist. I usually use the X value which results in nothing being returned when the record doesn't exist. Other values are V (returns null but displays an error indicating the record doesn't not exist), C (returns the table record ID if the record does not exist), and N (returns the table record ID if the results of the read (contents of the field) are null).

There are other ways to return code descriptions as well. XLATE, OCONV with the "Tfile" conversion code, custom "user exits", etc. Most code table translations that I use are of the type that utilizes TRANS and a user-exit conversion code that performs a translation.

For this exercise, we'll need to have access to either all dict items that contain the current dict item ID in field two or need to know if the current dict item field two contains the dict item ID in question.

In my first iteration, I wanted to select only dict items containing the current field ID in field two, but UniVerse complained (note that the new dictionary item is in DICT.DICT. This is so that it is available when looking at any file or table dictionary.):

Note: All programming displayed on this site is for illustrative purposes only. Use at your own risk.


0001 Subroutine DETTABLOO(out,mode)
...
0019 if not(init) then
0020    *
0021    * Initialize things...
0022    *
0023    init = true
0024    open "DICT",@FILENAME to D.FILE else error = true
0025 end
...
0044    cmd = "SELECT DICT ":@FILENAME:" WITH F2 MATCHES "
0045    cmd := '"0X':"'":@ID:"'":'0X"'
0046    cmd := " TO 8;"
0047    execute cmd capturing dummy
0049    done = false
0055    loop
0056       tmp = ""
0057       readnext dict.key from 8 then
...

>LIST DICT.DICT "IS.TABLE.LOOKUP" COL.SPCS

                Type &
Field.......... Field. Field........... Column.... Output Depth &
Name........... Number Definition...... Heading... Format Assoc..
IS.TABLE.LOOKUP I SUBR('DETTABLOO','D') Is Item    70L    M
                                        Code Table
                                        Lookup?

>SORT DICT PARTS IS.TABLE.LOOKUP

               Is item........................................
Field......... Code Table.....................................
Name.......... Lookup?........................................
@              Non-SQL re-entrant query calls are not allowed.
@ID            Non-SQL re-entrant query calls are not allowed.
PART.NUM       Non-SQL re-entrant query calls are not allowed.
VENDOR         Non-SQL re-entrant query calls are not allowed.
A_PARTS        Non-SQL re-entrant query calls are not allowed.

...


UniVerse does not like embedding SELECT statements in I-Types (and I'll be the first to admit it's probably bad practice). Next, I created a list of the dictionary items:



>SELECT TO SLIST 0 FROM DICT PARTS
SQL+WHERE TYPE='D' OR TYPE='I'
SQL+ORDER BY FIELD.NO, TYPE;

254 record(s) selected to SELECT list #0.

>>SAVE.LIST PARTS.DICT.ITEMS



Then I changed the subroutine called by the new I-Type to read this previously saved list:


>CT BP DETTABLOO

 1 Subroutine DETTABLOO(out,mode)
 2 *
 3 * Program DETECT.TABLE.LOOKUP
 4 *  This routine should be called from an I-type.
 5 *  Note: It will be called by every field in an Inform/RetrieVe statement.
 6 *
 7 * Arguments:
 8 *  out  : (output) Results of subroutine
 9 *  mode : (input)  If 'D' then output found I-type details. Otherwise only ID.
10 *
11 equ true to 1
12 equ false to 0
13 common /dettabloo/ init,dict.keys,D.FILE
14 results = ""
15 out = ""
16 error = false
17 truncate.pos = 70
18 if @RECCOUNT <= 1 then init = false ;* Force reinitialize if new query
19 if not(init) then
20    *
21    * Initialize things...
22    *
23    init = true
24    open "DICT",@FILENAME to D.FILE else error = true
25    dict.keys.list = @FILENAME:".DICT.ITEMS"
26    open "&SAVEDLISTS&" to F.SAVEDLISTS then
27       read dict.keys from F.SAVEDLISTS, dict.keys.list else
28          out<1,-1> = "Read Er! &SAVEDLISTS& ":dict.keys.list:"."
29          error = true
30       end
31    end else
32       out<1,-1> = "Unable to open &SAVEDLISTS&!"
33       error = true
34    end
35 end
36
37 if len(dict.keys) and not(error) then
38    match.pattern = '0X':"'TRANS('1X0X',":@ID:",'0X"
39    oconv.fn.match.pattern = '0X':"'OCONV(":@ID:",'0X'UCODES'0X"
40    more = true
41    cnt = 0
42    dict.keys = dict.keys ;* reset the pointer
43    loop
44       tmp = ""
45       remove dict.key from dict.keys setting more
46       if len(dict.key) and dict.key <> @ID then       ;* Shouldn't display "itself"
47          cnt += 1
48          read rec.dict from D.FILE, dict.key then
49             begin case
50                case upcase(trim(convert(" ","",rec.dict<2>))) matches match.pattern
51                   tmp = dict.key
52                case upcase(trim(convert(" ","",rec.dict<3>))) matches "'UCODES'0X" and rec.dict<2> = @ID
53                   tmp = dict.key
54                case upcase(trim(convert(" ","",rec.dict<2>))) matches oconv.fn.match.pattern
55                   tmp = dict.key
56             end case
57             if len(tmp) and upcase(trim(mode))[1,1] = "D" then
58                *
59                * Include details from the found I-type...
60                *
61                tmp := " ":rec.dict<1>[1,1]:"~":rec.dict<2>:"~":rec.dict<3>:"~":rec.dict<6>
62             end
63          end else tmp = "Read er '":dict.key:"'"
64       end
65       if len(tmp) then
66          results<1,-1> = tmp[1,truncate.pos]
67       end
68       until not(more)
69    repeat
70    out = results
71 end
72 return
73 end



The result is now the query can be run, returning only matching columns:



>SELECT @ID, IS.TABLE.LOOKUP FROM DICT PARTS
SQL+WHERE IS.TABLE.LOOKUP<>''
SQL+ORDER BY @ID;

           Is Item............................................
Field..... Code Table.........................................
Name...... Lookup?............................................
HIST.DISP  HIST.DISP.DESC I~HIST.DISP~UCODES*HIST.CODES~Desc~2

PART.ID    IN.AP I~LEN(TRANS(AP.DETAIL, INVOICE.NUM, PART.ID, 
           INVENTORY.ID I~SUBR('!CATS',TRANS(INVENTORY,PART.ID

PART.TYPE  PART.TYPE.DESC I~PART.TYPE~UCODES*PART.CODES~Desc~1

TYPE       TYPE.DESC I~TRANS(PART.TYPE,TYPE,DESC,'C')~~Desc~10
           TREAT.DESC I~PROCESS;IF @1#'' THEN TRANS(TREATMENT,
...

No comments:

Post a Comment