Neil's Tech Tips: 2016

Thursday, December 8, 2016

Extracting Pieces of Binary Dates

We recently received the following inquiry about extracting out portions of year, month and day, from numeric dates: Support Team,
Here is what I need to do, I have an I2 field with a date stored in YYYYMMDD format and what I need to be able to do is redefine the field so I can get to each piece. example:

    booking-date[1],4 = Century
    booking-date[5],2 = Month
    booking-date[7],2 = Day

Our response:
There is a way to isolate year, month and day in one step. It just involves some simple math in order to do what you want. It is not entirely obvious how to do this though. Myfile is a file with a double integer date field called "a" in the format ccyymmdd, below is a method to extract each portion.

>in myfile
>def year,1,4,display
>def month,1,2,display
>def day,1,2,display
>ext year=a / 10000
>ext month=(a / 100) mod 100
>ext day=a mod 100
>list
>xeq
>IN MYFILE.NEIL.GREEN (0) >OUT $NULL (0)
YEAR            = 2005           MONTH           = 2
DAY             = 7

You can also use the $edit function to isolate portions of the date and make the date more readable.

>in myfile
>def dispdata,1,10,byte
>ext dispdata=$edit(a,"9999 99 99")
>list
>xeq
>IN MYFILE.NEIL.GREEN (0) >OUT $NULL (0)
DISPDATA        = 2005 02 07

HP-UX for MPE users

My paper on HP-UX for MPE users. Posted for posterity. HP-UX for MPE Users

Disk IO papers and Anecdotes

An older disc IO paper that still have some relevance still in this day and age.

Living with 400 IO's per second

However, it is interesting to note that with IO performance even on SSD has interesting anecdotes.

The Myth of SSD Performance Degredation

Thursday, December 1, 2016

HP MPE Manuals and Papers

HP MPE Manuals

Ascii,Octal,Decimal, Binary data Table

Ascii Table

Dec	Hex	Oct	HTML	Chr	Binary
0	0	000	NUL	(null)	00000000
1	1	001		(start of heading)	00000001
2	2	002		(start of text)	00000010
3	3	003	ETX	(end of text)	00000011
4	4	004	EOT	(end of transmission)	00000100
5	5	005	ENQ	(enquiry)	00000101
6	6	006	ACK	(acknowledge)	00000110
7	7	007	BEL	(bell)	00000111
8	8	010	BS	(backspace)	00001000
9	9	011	TAB	(horizontal tab)	00001001
10	A	012	LF	(LineFeed)	00001010
11	B	013	VT	(vertical tab)	00001011
12	C	014	FF	(NP form feed)	00001100
13	D	015	CR	(carriage return)	00001101
14	E	016	SO	(shift out)	00001110
15	F	017	SI	(shift in)	00001111
16	10	020	DLE	(device link escape)	00010000
17	11	021	DC1	(device control 1)	00010001
18	12	022	DC2	(device control 2)	00010010
19	13	023	DC3	(device control 3)	00010011
20	14	024	DC4	(device control 4)	00010100
21	15	025	NAK	(negative acknowledge)	00010101
22	16	026	SYN	(synchronous idle)	00010110
23	17	027	ETB	(end of trans. block)	00010111
24	18	030	CAN	(cancel)	00011000
25	19	031	EM	(end of medium)	00011001
26	1A	032	SUB	(substitute)	00011010
27	1B	033	ESC	(escape)	00011011
28	1C	034	FS	(file separator)	00011100
29	1D	035	GS	(group separator)	00011101
30	1E	036	RS	(record separator)	00011110
31	1F	037	US	(unit separator)	00011111
32	20	040		Space	00100000
33	21	041	!	!	00100001
34	22	042	"	"	00100010
35	23	043	#	#	00100011
36	24	044	$	$	00100100
37	25	045	%	%	00100101
38	26	046	&	&	00100110
39	27	047	'	'	00100111
40	28	050	(	(	00101000
41	29	051	)	)	00101001
42	2A	052	*	*	00101010
43	2B	053	+	+	00101011
44	2C	054	,	,	00101100
45	2D	055	-	-	00101101
46	2E	056	.	.	00101110
47	2F	057	/	/	00101111
48	30	060	0	0	00110000
49	31	061	1	1	00110001
50	32	062	2	2	00110010
51	33	063	3	3	00110011
52	34	064	4	4	00110100
53	35	065	5	5	00110101
54	36	066	6	6	00110110
55	37	067	7	7	00110111
56	38	070	8	8	00111000
57	39	071	9	9	00111001
58	3A	072	:	:	00111010
59	3B	073	;	;	00111011
60	3C	074	<	<	00111100
61	3D	075	=	=	00111101
62	3E	076	>	>	00111110
63	3F	077	?	?	00111111
64	40	100	@	@	01000000
65	41	101	A	A	01000001
66	42	102	B	B	01000010
67	43	103	C	C	01000011
68	44	104	D	D	01000100
69	45	105	E	E	01000101
70	46	106	F	F	01000110
71	47	107	G	G	01000111
72	48	110	H	H	01001000
73	49	111	I	I	01001001
74	4A	112	J	J	01001010
75	4B	113	K	K	01001011
76	4C	114	L	L	01001100
77	4D	115	M	M	01001101
78	4E	116	N	N	01001110
79	4F	117	O	O	01001111
80	50	120	P	P	01010000
81	51	121	Q	Q	01010001
82	52	122	R	R	01010010
83	53	123	S	S	01010011
84	54	124	T	T	01010100
85	55	125	U	U	01010101
86	56	126	V	V	01010110
87	57	127	W	W	01010111
88	58	130	X	X	01011000
89	59	131	Y	Y	01011001
90	5A	132	Z	Z	01011010
91	5B	133	[	[	01011011
92	5C	134	\	\	01011100
93	5D	135	]	]	01011101
94	5E	136	^	^	01011110
95	5F	137	_	_	01011111
96	60	140	`	`	01100000
97	61	141	a	a	01100001
98	62	142	b	b	01100010
99	63	143	c	c	01100011
100	64	144	d	d	01100100
101	65	145	e	e	01100101
102	66	146	f	f	01100110
103	67	147	g	g	01100111
104	68	150	h	h	01101000
105	69	151	i	i	01101001
106	6A	152	j	j	01101010
107	6B	153	k	k	01101011
108	6C	154	l	l	01101100
109	6D	155	m	m	01101101
110	6E	156	n	n	01100100
111	6F	157	o	o	01100101
112	70	160	p	p	01110000
113	71	161	q	q	01110001
114	72	162	r	r	01110010
115	73	163	s	s	01110011
116	74	164	t	t	01110100
117	75	165	u	u	01110101
118	76	166	v	v	01110110
119	77	167	w	w	01110111
120	78	170	x	x	01111001
121	79	171	y	y	01111010
122	7A	172	z	z	01111011
123	7B	173	{	{	01111111
124	7C	174	\|	\|	01111100
125	7D	175	}	}	01111101
126	7E	176	~	~	01111110
127	7F	177		DEL	01111111

Removing Spaces

Removing Spaces

I recently needed to remove a bunch of spaces and needed to compress some data down and found that tr -s was exactly what I needed.


 more taxref
 6212301245700000123456    00000588005617512580            JOHN SMITH           0042158657802577
 6212301245700000123456    00000588005617512580            JOHN SMITH           0042198757802577
 6212301245700000123456    00000600005617512580            SHARON JONES         0042198757802577
 6212301245700000123456    00000588005617512580            JOHN SMITH                     0042158657802577
 6212301245700000123456    00000588005617512580            JOHN SMITH                     0042198757802577
 6212301245700000123456    00000600005617512580            SHARON JONES              0042198757802577
 tr -s " " >newtax
 more newtax
 6212301245700000123456 00000588005617512580 JOHN SMITH 0042158657802577
 6212301245700000123456 00000588005617512580 JOHN SMITH 0042198757802577
 6212301245700000123456 00000600005617512580 SHARON JONES 0042198757802577
 6212301245700000123456 00000588005617512580 JOHN SMITH 0042158657802577
 6212301245700000123456 00000588005617512580 JOHN SMITH 0042198757802577
 6212301245700000123456 00000600005617512580 SHARON JONES 0042198757802577

Although this may not be exactly what you need it certainly helped me compress down some data and get ride of a lot of extraneous spaces.

Importing Data using Suprtool

Import Data Using Suprtool

One of the more recent questions that has come up lately is How Do I Import data with Suprtool. Let's say we have the following data layout, Image, Eloquence or SD file, it doesn't matter. The purpose of this small white paper would be to extract data to a ".csv" file, and then import that same data back. Closing the loop so to speak.

BIN-NO ~ J1
LAST-SHIP-DATE ~ J2
ON-HAND-QTY ~ J2
PRODUCT-NO ~ Z8
SUPPLIER-NO ~ Z8
UNIT-COST ~ P8
ITEM-DESC1 ~ X20
ITEM-DESC2 ~ X20
ITEM-DESC3 ~ X20
ITEM-DESC4 ~ X20

To begin our project we will extract the data from a sample data source and output to an SD file and then use STExport to create a CSV file.

>get d-inventory
>out dinv,link
>xeq
IN=13, OUT=13. CPU-Sec=1. Wall-Sec=1.

:run stexport.pub.robelle
$in dinv
$out dinvcsv
$xeq
In=13. Out=13. CPU-Sec=1. Wall-Sec=1.
$listf dinvcsv,2

ACCOUNT=  GREEN       GROUP=  NEIL
FILENAME  code  ------------LOGICAL RECORD-----------  ----SPACE----
                  SIZE  TYP        EOF      LIMIT R/B  SECTORS #X MX

DINVCSV           152B  VA          13         13   1       16  1  *

So at this point we know have a file, typically how a customer would want to import using Suprtool for adding to a database etc. Note that Suprtool does not handle variable-length files so the first step is to convert the Variable length file to fixed length.

Step One: Convert to Fixed Length

On MPE you can convert using Fcopy:

/file dinvcsvf;rec=-152,1,f,ascii
/fcopy from=dinvcsv; to=*dinvcsvf;new

On HP-UX you can use Qedit:

/t dinvcsv
/set keep var off
/k dinvcsvf

Or Awk: (Thanks to Barry Lake from Allegro for fixify.sh)

#!/bin/sh
#
# Script to turn a typical bytestream file (variable length
# records) into a file with fixed length records by padding
# records with spaces as needed. The resulting record length
# will be that of the longest record in the file.

export INFILE=$1
OUTFILE=$(mktemp)

# Step 1: Find the length of the longest record in the input file
#         file and store it in a variable for use in the next step.

export MAXLEN=$(awk 'BEGIN { len = 0; }
  { if (length > len)
       len = length; }
  END { print len; }' $INFILE )

echo Maximum record length in \"$INFILE\" is $MAXLEN.

# Step 2: Get the MAXLEN variable; use it to create a string
#         of that many blanks; then use that to pad each input
#         record as needed to make it the same length as the
#         longest record.

awk 'BEGIN { "echo $MAXLEN" | getline maxlen; spaces = "";
             for(i=0; i < maxlen * 1; i++)
                spaces = " "spaces; }
  { print substr($0 spaces, 1, maxlen) }' $INFILE >$OUTFILE

# Step 3: awk can't edit a file in place so its output was
#         written to a new file which we then pour back into the
#         original file. Note: we could just as easily have done
#         cp $OUTFILE $INFILE or mv $OUTFILE $INFILE, but in that
#         case we'd lose the original file's creator and
#         permission bits.

cat $OUTFILE > $INFILE
rm $OUTFILE

You can run the above script:

$./fixify.sh datafile

At this point Suprtool can now read what is essentially variable-length data in a fixed length file.

Now remember what a typical CSV file looks like! Byte fields are surronded by quotes and separated or delimited with commas:

159,19910827,1,50532001,5053,9449,"Test index","Test index","Test index","Test index"

Step Two: Split out the Fields

The first step is to separate out each field from the record based on the delimeter, which in this case is the comma. I use byte lengths for each number field based on the rules for output ,ascii table.

Duplicated below:

  I1 J1 06 bytes      
  I2 J2 11 bytes
  I3 J3 16 bytes      
  I4 J4 20 bytes
  K1    05 bytes      
  K2    10 bytes
  Zn    n+1 bytes     
  Pn    n bytes

in dinvcsvf
{define targets}
def bin-x,1,6
def last-x,1,11
def qty-x,1,11
def prod-x,1,9
def supp-x,1,9
def cost-x,1,8
def desc1-x,1,22 {Note room for quotes}
def desc2-x,1,22
def desc3-x,1,22
def desc4-x,1,22

{define source}
def record,1,152

{extract using split }
 
ext bin-x=$split(record,first,",")
ext last-x=$split(record,",",1,",")
ext qty-x=$split(record,",",2,",")
ext prod-x=$split(record,",",3,",")
ext supp-x=$split(record,",",4,",")
ext cost-x=$split(record,",",5,",")
ext desc1-x=$split(record,",",6,",")
ext desc2-x=$split(record,",",7,",")
ext desc3-x=$split(record,",",8,",")
ext desc4-x=$trim($split(record,",",9,last))

{where?}
out myfile,link
xeq

Step Three: Closing the Loop

Now we just need to "close the loop" and extract the individual byte type fields into their appropriate data types. In this step we also "clean" the data of the double quotes.

Keep in mind that the data format that we want:

BIN-NO ~ J1
LAST-SHIP-DATE ~ J2
ON-HAND-QTY ~ J2
PRODUCT-NO ~ Z8
SUPPLIER-NO ~ Z8
UNIT-COST ~ P8
ITEM-DESC1 ~ X20
ITEM-DESC2 ~ X20
ITEM-DESC3 ~ X20
ITEM-DESC4 ~ X20

The defines for the above are in the section starting with the comment {Actual targets}

in myfile

{re-define number in display format}
def bin-z,bin-x,display
def last-z,last-x,display
def qty-z,qty-x,display
def prod-z,prod-x,display
def supp-z,supp-x,display
def cost-z,cost-x,display

{Actual targets}

{number}
def bin ,1,2,integer
def last,1,4,double
def qty ,1,4,double
def prod,1,8,display
def supp,1,8,display
def cost,1,4,packed

{bytes}
def desc1,1,20 
def desc2,1,20
def desc3,1,20
def desc4,1,20 

ext bin=$number(bin-z)
ext last=$number(last-z)
ext qty=$number (qty-z)
ext prod=$number(prod-z)
ext supp=$number(supp-z)
ext cost=$number(cost-z)

clean '"'
ext desc1=$trim($clean(desc1-x))
ext desc2=$trim($clean(desc2-x))
ext desc3=$trim($clean(desc3-x))
ext desc4=$trim($clean(desc4-x))

out loop,link
xeq

The SD file (loop) is now in the same format and layout of the original Dataset extraction prior to the STExport task. We've now closed the loop.

>form loop
    File: LOOP.NEIL.GREEN     (SD Version B.00.00)
       Entry:                     Offset
          BIN                  I1      1
          LAST                 I2      3
          QTY                  I2      7
          PROD                 Z8     11
          SUPP                 Z8     19
          COST                 P8     27
          DESC1                X20    31
          DESC2                X20    51
          DESC3                X20    71
          DESC4                X20    91
    Limit: 13  EOF: 13  Entry Length: 110  Blocking: 37

So to summarize the first step is to split out the data into separate fields with byte data types. Then to convert by re-defining with a new name to reference the data as display and use $clean and $number to extract into the final targets.

Normalizing Zip Codes

Fix all of My Zip codes

Recently a customer asked how they could fix some of the Zip codes which were in the form of:

123450000

and are stored in a numeric J2 field.

The customer wanted to normalize those zip codes that had the four trailing zeroes to be 12345 instead of 123450000.

The first step we wanted to do was to determine all of the codes that needed to be updated and what the old zip would be and what the new zip would be.

 >base membrs
 >get member-file
 >def new-zip,1,4,double
 >if zip > 99999 and (zip mod 10000) = 0
 >ext account
 >ext zip
 >ext new-zip = zip / 10000
 >list
 >xeq

So what is the above doing?

Well the if command looks at all records that are greater than 99999 and ends in the four zeroes, which is what the (zip mod 10000) = 0 is doing. This should isolate just those records that the customer wanted to fix!

Once we determined that we had the correct records selected we easily updated them with:

 >base membrs
 >get member-file
 >if zip > 99999 and (zip mod 10000) = 0
 >update
 >ext new-zip = zip / 10000
 >list
 >xeq

How Do I Convert CM KSAM to NM KSAM

How Do I Convert CM Ksam to NM KSAM?

Suprtool can't/won't create a new NM KSAM file for you. You will have to create the new NM file first using the MPE BUILD command (or some other method, see below), then use Suprtool to copy the records from the old file to the new file.

But Suprtool should definitely be able to copy the data *much* faster than MPE's FCOPY utility could.

The trick, of course, is getting a new NM KSAM file built correctly first. You could use a complicated BUILD command or you could do this:

 :file n=newfile; disc=
 :fcopy from=oldfile; to=(*n); subset=0,1

That will create a new NM KSAM file called NEWFILE with the FLIMIT equal to the FLIMIT of your current CM file, and with all the keys set up correctly, but will copy only a single record into it. Then use Suprtool:

 :suprtool
 >in oldfile
 >out newfile, erase
 >xeq

Finally, if it's a big KSAM file you may wish to create it as temporary first, then SAVE it after you're done, to squeeze even more speed out of the process:

 :file n=newfile; disc=; temp     <<-- Note the temp designation
 :fcopy from=oldfile; to=(*n); subset=0,1
 :suprtool
 >in oldfile
 >out newfile, erase
 >exit
 :save newfile

Why is my MPE job suddenly failing?

Why is my Job Suddenly Failing?

I had a recent call in to support asking why all of a sudden some jobs started failing in a job stream. The report was a blank line after run of a program suddenly started giving the error:

Missing colon before command name. (CIERR 981)

In previous incarnations the job stream with the blank line would NOT fail but nothing changed... of course. :)

First off I want to confirm that a blank line does abort a job stream.

:comment bland line is next Missing colon before command name. (CIERR 981) REMAINDER OF JOB FLUSHED. CPU sec. = 1. elapsed min. = 1. THU, FEB 4, 2010, 10:47 AM.

And I found it does.

The customer though showed that the blank line was after the run of a program and in this case I am using query as an example. We didn't see the same behaviour. Odd.

	:comment
	:comment test blank line after run query.pub.sys
	:comment
	:purge file1x
	:query


	HP32216N.03.18  QUERY/NM  THU, FEB  4, 2010, 10:18 AM
	COPYRIGHT HEWLETT-PACKARD CO. 1976

	exit


	END OF PROGRAM
	:showjcw jcw
	JCW = 0
	:showjcw cierror
	CIERROR = 0
	:eoj
	CPU sec. = 2.  elapsed min. = 1.  THU, FEB  4, 2010, 10:18 AM.

Some investigation and some clues from something I had remembered investigating in 2001 allowed me to duplicate by switching to query being run/resolved via a command file.

In the above example even though the commands were the same, query was being run via path resolution. This is the part that was tricky and I later make the examples explicit by specifically running query.pub.sys or using my query command file:

	:comment
	:comment  Blank line after query which resolves to a command file
	:comment
	:query


	HP32216N.03.18  QUERY/NM  THU, FEB  4, 2010, 10:20 AM
	COPYRIGHT HEWLETT-PACKARD CO. 1976

	exit


	END OF PROGRAM

	Missing colon before command name. (CIERR 981)
	REMAINDER OF JOB FLUSHED.

Another example but this time with garbage commands:

	:comment query command file with garbage after exit
	:query


	HP32216N.03.18  QUERY/NM  THU, FEB  4, 2010, 10:44 AM
	COPYRIGHT HEWLETT-PACKARD CO. 1976

	exit


	END OF PROGRAM
	yabba dabba doo
	Missing colon before command name. (CIERR 981)
	REMAINDER OF JOB FLUSHED.
	CPU sec. = 2.  elapsed min. = 1.  THU, FEB  4, 2010, 10:44 AM.

Now I switched back to running directly with the yabba dabba doo still in the job and some other lines:

	:comment
	:run query.pub.sys


	HP32216N.03.18  QUERY/NM  THU, FEB  4, 2010, 10:45 AM
	COPYRIGHT HEWLETT-PACKARD CO. 1976

	exit


	END OF PROGRAM
	:showjcw jcw
	JCW = 0
	:showjcw cierror
	CIERROR = 383
	:eoj
	CPU sec. = 2.  elapsed min. = 1.  THU, FEB  4, 2010, 10:45 AM.

In the case of a run of the program file the garbage lines after the run are being read as $stdin until it sees a "!". So what happens is the program exits and the extra lines left in the stdin are thrown away.

However, if you switch this run to a command file, suddenly the job stops running to completion.

So, if you have a customer that switches from say

query

which is run thru HPPATH resolution, to having

query

be resolved via a command file, the jobs with blank lines or garbage after the exit line will suddenly stop failing.

It's a bit tricky to diagnose especially if the customer doesn't believe you or points to something else. I have not tested UDC's but I would believe that they would have the same behaviour. My guess is that when a command file ends MPE just reads the next line in the job stream, but when a program ends the job stream is trying to re-orient itself in regard to stdin and just reads until is sees a "!". That is the behaviour that I am seeing.

Any past labbies or gurus care to comment or have thoughts.

While loops in Qedit

How do I do a while loop in Qedit/UX?

There are occasions when you need to do a while loop to repeat multiple edit commands in Qedit, typically the edit operations are not on the same line as the condition or data you want to change or edit.

Recently we had the following request:

I am using Qedit for HPUX. I have a file where I would like to execute the following qedit commands until end of file is reached:

fq 707C(1/4)
lq * - 1
c 5/5 C
lq * + 1

Basically, I am trying to change the line previous to one with 707C in positions 1 to 4 for any occurrence of a line with 707C in positions 1 to 4. Is that possible?

Naturally, I wanted to help the customer get the job done, so here is what I came up with in a file called mytest.

rm qedituse
export lines=$(grep '^707C' file | wc -l)
echo tq file >>qedituse
echo lq [    >>qedituse
x=0
while [ $x -lt $lines ]; do 
echo "fq '707C'(1/4);cq 5/5 'C' *-1;lq *+1"  >>qedituse
x=`expr $x + 1`
done
echo k newfile,yes >> qedituse
echo exit          >> qedituse
qedit -c'use qedituse'

The resulting file had the lines with C in column 5 preceeding the 707C. blinC 707C ack ick bla asdfC 707C hippy hoppy frippy froppy a 707 ha ack C 707C Neo%/home/neil: The process broken down as follows: The following just removes the file qedituse and then stores in a variable called lines the number of lines that start with 707C.

rm qedituse
export lines=$(grep '^707C' file | wc -l)

The next two lines simply text in the file and positions the file pointer at the beginning of the file.

echo tq file >>qedituse
echo lq [    >>qedituse

The next portion, is the while loop that will go thru the file "lines" number of times and issue the desidred qedit commands. Notice that cq 5/5 'C' *-1, means put a C in column 5 of the preceding line.

x=0
while [ $x -lt $lines ]; do 
echo "fq '707C'(1/4);cq 5/5 'C' *-1;lq *+1"  >>qedituse
x=`expr $x + 1`
done

The next two lines keep the file and exit

echo kq newfile,yes >> qedituse
echo exit           >> qedituse

The following is run qedit with the editor commands and actually do the task.

qedit -c'use qedituse'

Given what I learned now I would write things a little more compact and do as follows:

rm qedituse
echo t file;l [ >>qedituse
export lines=$(grep '^707C' file | wc -l)
x=0
while [ $x -lt $lines ]; do 
echo "fq '707C'(1/4);cq 5/5 'C' *-1;lq *+1"  >>qedituse
x=`expr $x + 1`
done
echo k newfile,yes;exit >> qedituse
qedit -c'useq qedituse'

You could also use parms and variables to make this even more powerful by allowing you to specify the string to search for etc.

Difference Between Two Dates

How do I find the difference between two dates

While on training recently I was asked by a customer to find the difference between a due-date for a payment and the current date. However, they only wanted to list the dates that were overdue as the number of days overdue, and if the payment was not overdue then they should show a zero as the days difference.

Now the best way to calculate a difference between two days is to convert the date using the $days function and subtract the two dates.

The $days function converts any date to the number of days since 4713 BC, and is known as Julian Day number. Therefore you can perform or figure out the difference between two dates. The task below has a couple of tricks, the first is to use Suprtool to build a command file to get the current date into a variable in Julian Day format!

The second part of the script figures out the difference between the two dates, keep in mind that the customer wants to know which dates are "overdue" and only want to see those that are overdue, so we re-order the subtraction such that overdue payments will be a positive number and those payments that are not yet due, will be a negative number.

rm tdays tdays.sd
rm setdate
export EQ_DBSERVER=":8202"
suprtool << EOD_Suprtool
{ Set $mydate variable to todays date in julian day format }
base membrs,5,lookup
get member-file
num 1
def tdays,1,4,double
item tdays,date,julian
ext tdays=\$today
out tdays,link
xeq
in tdays
def tdayascii,1,7,byte
ext 'export MYJULDAY="'
ext tdayascii=\$edit(tdays,"zzzzzzz")
ext '"'
out setdate
exit
EOD_Suprtool
chmod +x setdate
. ./setdate
rm setdate
suprtool << EOD_Suprtool
set varsub on
in dates
def diff,1,4,double
item a,date,ccyymmdd
ext a
ext diff=(\$MYJULDAY - \$DAYS(A))
list
xeq
exit
EOD_Suprtool

Given some dates here is what you would see:

 >IN dates (0) >OUT $NULL (0)
A               = 20131213       DIFF            = 47

>IN dates (1) >OUT $NULL (1)
A               = 20131231       DIFF            = 29

>IN dates (2) >OUT $NULL (2)
A               = 20140201       DIFF            = -3

>IN dates (3) >OUT $NULL (3)
A               = 20140130       DIFF            = -1

>IN dates (4) >OUT $NULL (4)
A               = 20140115       DIFF            = 14

IN=5, OUT=5. CPU-Sec=1. Wall-Sec=1.

>exit

Now since we only want to see positive numbers, if we change the target type to be logical, we will only get the difference in days with a positive number and the negatives will become zero since the definition of a logical number is that it cannot be negative.

 Neo%dev/source/suprtool: ./datediff
rm: setdate non-existent
SUPRTOOL/UXia/Copyright Robelle Solutions Technology Inc. 1981-2014.
(Version 5.6 Internal)  WED, JAN 29, 2014, 11:55 AM  Type H for help.
Build 11
>{ Set  variable to todays date in julian day format }
>base membrs,5,lookup
>get member-file
>num 1
>def tdays,1,4,double
>item tdays,date,julian
>ext tdays=$today
>out tdays,link
>xeq

Warning:  NUMRECS exceeded; some records not processed.
IN=2, OUT=1. CPU-Sec=1. Wall-Sec=1.

>in tdays
>def tdayascii,1,7,byte
>ext 'export MYJULDAY="'
>ext tdayascii=$edit(tdays,"zzzzzzz")
>ext '"'
>out setdate
>exit
IN=1, OUT=1. CPU-Sec=1. Wall-Sec=1.

SUPRTOOL/UXia/Copyright Robelle Solutions Technology Inc. 1981-2014.
(Version 5.6 Internal)  WED, JAN 29, 2014, 11:55 AM  Type H for help.
Build 11
>set varsub on
>in dates
>def diff,1,4,logical  {note target is now logical}
>item a,date,ccyymmdd
>ext a
>ext diff=($MYJULDAY - $DAYS(A))
>list
>xeq
>IN dates (0) >OUT $NULL (0)
A               = 20131213       DIFF            = 47

>IN dates (1) >OUT $NULL (1)
A               = 20131231       DIFF            = 29

>IN dates (2) >OUT $NULL (2)
A               = 20140201       DIFF            = 0

>IN dates (3) >OUT $NULL (3)
A               = 20140130       DIFF            = 0

>IN dates (4) >OUT $NULL (4)
A               = 20140115       DIFF            = 14

IN=5, OUT=5. CPU-Sec=1. Wall-Sec=1.

>exit

Normalizing Data

How do I Normalize Phone Numbers?

Recent question about Phone Numbers and how to remove non-number characters from a byte container, raised some interesting solutions to normalizing phone numbers:

Considering the following data, you see that the phone numbers have all sorts of different formats.

>in myphone
>list
>xeq
>IN myphone (0) >OUT $NULL (0)
PHONENUM        = #123.456.7890

>IN myphone (1) >OUT $NULL (1)
PHONENUM        = (123)567-1234

>IN myphone (2) >OUT $NULL (2)
PHONENUM        = (321).123.5678

IN=3, OUT=3. CPU-Sec=1. Wall-Sec=1.

The steps in normalizing the data is to remove the non-numeric numbers:

>in myphone
>set cleanchar ""
>clean "^0:^47","^58:^255"
>def newphone,1,14
>ext phonenum=$clean(phonenum)
>out newphone,link
>xeq
IN=3, OUT=3. CPU-Sec=1. Wall-Sec=1.

>in newphone
>list
>xeq
>IN newphone (0) >OUT $NULL (0)
PHONENUM        = 1234567890

>IN newphone (1) >OUT $NULL (1)
PHONENUM        = 1235671234

>IN newphone (2) >OUT $NULL (2)
PHONENUM        = 3211235678

IN=3, OUT=3. CPU-Sec=1. Wall-Sec=1.

You can then use an edit mask to format it in the same way. You do need to redefine the field being edited with a define of the number with just the length of the phone number:

>in newphone
>form
    File: newphone     (SD Version B.00.00)  Has linefeeds
       Entry:                     Offset
          PHONENUM             X14     1
    Entry Length: 14  Blocking: 1
>def my,phonenum,10
>def targ,1,12
>ext targ=$edit(my,"xxx.xxx.xxxx")
>list
>xeq
>IN newphone (0) >OUT $NULL (0)
TARG            = 123.456.7890

>IN newphone (1) >OUT $NULL (1)
TARG            = 123.567.1234

>IN newphone (2) >OUT $NULL (2)
TARG            = 321.123.5678

IN=3, OUT=3. CPU-Sec=1. Wall-Sec=1.

Translating data

New Translate Function

Given the recent article and How Do I request on how to Obfuscate test data I realized that if I wrote a new function to do this transformation of a byte field if there was a method to provide a from character and a to character. So we've added the Translate command to specify what character to translate from and to, and the $translate function to apply that translation table. The translate command allows you to specify in decimal the character you want to translate from and to. For example if you want to transform Capital-A to Capital-Z you just enter the command

Translate "^65:^90"
ext name=$translate(name)

The extract command will change "Neil Armstrong" to "Neil Zrmstrong". We've also provided a sample translation table which will translate many readable characters to other readable characters just by using:

 Translate Tounread

You can see an example below:

>get m-supplier
>ext supplier-name
>list stan
>xeq
May 02, 2014  8:08      Base STORE.TESTSD Set M-SUPPLIER             Page 1   
 
SUPPLIER-NAME
 
Makita Canada Inc
SKIL Power Tools
Black & Decker
IN=3, OUT=3. CPU-Sec=1. Wall-Sec=1.

>get m-supplier
>translate tounread
>update
>ext supplier-name=$translate(supplier-name)
>xeq
Update all records from the M-SUPPLIER dataset [no]: yes
Warning:  Using DBGET for the input records
IN=3, OUT=3. CPU-Sec=1. Wall-Sec=1.

>get m-supplier
>ext supplier-name
>list stan
>xeq
May 02, 2014  8:12      Base STORE.TESTSD Set M-SUPPLIER             Page 1   
 
SUPPLIER-NAME
 
Npzxep Qpmpsp Wmr
HYWZ Klhtc Gllod
Poprz ; Rtrztc
IN=3, OUT=3. CPU-Sec=1. Wall-Sec=1.

>get m-supplier
>translate toread
>ext supplier-name=$translate(supplier-name)
>list
>list stan

Warning:  Previous >LIST options reset
>xeq
May 02, 2014  8:12      Base STORE.TESTSD Set M-SUPPLIER             Page 1   
 
SUPPLIER-NAME
 
Makita Canada Inc
SKIL Power Tools
Black & Decker
IN=3, OUT=3. CPU-Sec=1. Wall-Sec=1.

This new feature is not meant as a method to encrypt data but does allow for you to quickly make test data unreadable.

Obfuscating Test Data

I recently was asked how could you Obfuscate data in a byte type field AND be able to bring it back. Short of writing a $encrypt and $decrypt function, which may be in the works, I came up with the following:

Note the Product-desc field:

/RUN SUPRTOOL.PUB.ROBELLE

SUPRTOOL/Copyright Robelle Solutions Technology Inc. 1981-2014.
(Version 5.6.12 Internal)  MON, APR  7, 2014,  3:46 PM  Type H for help.
>BASE STORE,5,READER
>GET M-PRODUCT
>LIST
>XEQ
>GET M-PRODUCT (4) >OUT $NULL (0)
PRODUCT-DESC    = Skil 3/8" Variable Speed Drill
PRODUCT-MODEL   = #6523          PRODUCT-NO      = 50531501

>GET M-PRODUCT (39) >OUT $NULL (1)
PRODUCT-DESC    = B&D Router
PRODUCT-MODEL   = #7613-04       PRODUCT-NO      = 50522001

>GET M-PRODUCT (49) >OUT $NULL (2)
PRODUCT-DESC    = Skil Var. Sp. Auto-Scroll Saw
PRODUCT-MODEL   = #4560          PRODUCT-NO      = 50533001

>GET M-PRODUCT (50) >OUT $NULL (3)
PRODUCT-DESC    = Skil 8 1/2" Circular Saw
PRODUCT-MODEL   = #5665          PRODUCT-NO      = 50532501

>GET M-PRODUCT (52) >OUT $NULL (4)
PRODUCT-DESC    = B&D Cordless Screwdriver
PRODUCT-MODEL   = #9018-04       PRODUCT-NO      = 50521001

>GET M-PRODUCT (103) >OUT $NULL (5)
PRODUCT-DESC    = Makita 8 1/4" Circular Saw
PRODUCT-MODEL   = #5008NB        PRODUCT-NO      = 50512501

>GET M-PRODUCT (146) >OUT $NULL (6)
PRODUCT-DESC    = B&D Variable Speed Jig Saw
PRODUCT-MODEL   = #7548-04       PRODUCT-NO      = 50523001

>GET M-PRODUCT (164) >OUT $NULL (7)
PRODUCT-DESC    = Makita 1/2" Router
PRODUCT-MODEL   = #3601B         PRODUCT-NO      = 50512001

>GET M-PRODUCT (171) >OUT $NULL (8)
PRODUCT-DESC    = Makita 3/8" Var. Speed Drill
PRODUCT-MODEL   = #DP3730        PRODUCT-NO      = 50511501

>GET M-PRODUCT (221) >OUT $NULL (9)
PRODUCT-DESC    = Skil Router
PRODUCT-MODEL   = #1835          PRODUCT-NO      = 50532001

>GET M-PRODUCT (231) >OUT $NULL (10)
PRODUCT-DESC    = B&D 7 1/4" Circular Saw
PRODUCT-MODEL   = #5728          PRODUCT-NO      = 50522501

>GET M-PRODUCT (241) >OUT $NULL (11)
PRODUCT-DESC    = B&D 3/8" Variable Speed Drill
PRODUCT-MODEL   = #P1149         PRODUCT-NO      = 50521501

>GET M-PRODUCT (243) >OUT $NULL (12)
PRODUCT-DESC    = Makita 1" Jig Saw
PRODUCT-MODEL   = #4300 BV       PRODUCT-NO      = 50513001

IN=13, OUT=13. CPU-Sec=1. Wall-Sec=1.

I made a simple translate file with the intended use being in a table with data. The key would be match to the original data and the Trans field would be what the data would become.

>in trans1
>list
>xeq
>IN TRANS1.NEIL.GREEN (0) >OUT $NULL (0)
KEY             = A              TRANS           = S

>IN TRANS1.NEIL.GREEN (1) >OUT $NULL (1)
KEY             = B              TRANS           = T

>IN TRANS1.NEIL.GREEN (2) >OUT $NULL (2)
KEY             = C              TRANS           = U

>IN TRANS1.NEIL.GREEN (3) >OUT $NULL (3)
KEY             = D              TRANS           = V

>IN TRANS1.NEIL.GREEN (4) >OUT $NULL (4)
KEY             = E              TRANS           = W

>IN TRANS1.NEIL.GREEN (5) >OUT $NULL (5)
KEY             = F              TRANS           = X

>IN TRANS1.NEIL.GREEN (6) >OUT $NULL (6)
KEY             = G              TRANS           = Y

>IN TRANS1.NEIL.GREEN (7) >OUT $NULL (7)
KEY             = H              TRANS           = Z

>IN TRANS1.NEIL.GREEN (8) >OUT $NULL (8)
KEY             = I              TRANS           = A

>IN TRANS1.NEIL.GREEN (9) >OUT $NULL (9)
KEY             = J              TRANS           = B

>IN TRANS1.NEIL.GREEN (10) >OUT $NULL (10)
KEY             = K              TRANS           = C

>IN TRANS1.NEIL.GREEN (11) >OUT $NULL (11)
KEY             = L              TRANS           = D

>IN TRANS1.NEIL.GREEN (12) >OUT $NULL (12)
KEY             = M              TRANS           = E

>IN TRANS1.NEIL.GREEN (13) >OUT $NULL (13)
KEY             = N              TRANS           = F

>IN TRANS1.NEIL.GREEN (14) >OUT $NULL (14)
KEY             = O              TRANS           = G

>IN TRANS1.NEIL.GREEN (15) >OUT $NULL (15)
KEY             = P              TRANS           = H

>IN TRANS1.NEIL.GREEN (16) >OUT $NULL (16)
KEY             = Q              TRANS           = I

>IN TRANS1.NEIL.GREEN (17) >OUT $NULL (17)
KEY             = R              TRANS           = J

>IN TRANS1.NEIL.GREEN (18) >OUT $NULL (18)
KEY             = S              TRANS           = K

>IN TRANS1.NEIL.GREEN (19) >OUT $NULL (19)
KEY             = T              TRANS           = L

>IN TRANS1.NEIL.GREEN (20) >OUT $NULL (20)
KEY             = U              TRANS           = M

>IN TRANS1.NEIL.GREEN (21) >OUT $NULL (21)
KEY             = V              TRANS           = N

>IN TRANS1.NEIL.GREEN (22) >OUT $NULL (22)
KEY             = W              TRANS           = O

>IN TRANS1.NEIL.GREEN (23) >OUT $NULL (23)
KEY             = X              TRANS           = P

>IN TRANS1.NEIL.GREEN (24) >OUT $NULL (24)
KEY             = Y              TRANS           = Q

>IN TRANS1.NEIL.GREEN (25) >OUT $NULL (25)
KEY             = Z              TRANS           = R

>IN TRANS1.NEIL.GREEN (26) >OUT $NULL (26)
KEY             = a              TRANS           = s

>IN TRANS1.NEIL.GREEN (27) >OUT $NULL (27)
KEY             = b              TRANS           = t

>IN TRANS1.NEIL.GREEN (28) >OUT $NULL (28)
KEY             = c              TRANS           = u

>IN TRANS1.NEIL.GREEN (29) >OUT $NULL (29)
KEY             = d              TRANS           = v

>IN TRANS1.NEIL.GREEN (30) >OUT $NULL (30)
KEY             = e              TRANS           = w

>IN TRANS1.NEIL.GREEN (31) >OUT $NULL (31)
KEY             = f              TRANS           = x

>IN TRANS1.NEIL.GREEN (32) >OUT $NULL (32)
KEY             = g              TRANS           = y

>IN TRANS1.NEIL.GREEN (33) >OUT $NULL (33)
KEY             = h              TRANS           = z

>IN TRANS1.NEIL.GREEN (34) >OUT $NULL (34)
KEY             = i              TRANS           = b

>IN TRANS1.NEIL.GREEN (35) >OUT $NULL (35)
KEY             = j              TRANS           = c

>IN TRANS1.NEIL.GREEN (36) >OUT $NULL (36)
KEY             = k              TRANS           = d

>IN TRANS1.NEIL.GREEN (37) >OUT $NULL (37)
KEY             = l              TRANS           = e

>IN TRANS1.NEIL.GREEN (38) >OUT $NULL (38)
KEY             = m              TRANS           = f

>IN TRANS1.NEIL.GREEN (39) >OUT $NULL (39)
KEY             = n              TRANS           = g

>IN TRANS1.NEIL.GREEN (40) >OUT $NULL (40)
KEY             = o              TRANS           = h

>IN TRANS1.NEIL.GREEN (41) >OUT $NULL (41)
KEY             = p              TRANS           = i

>IN TRANS1.NEIL.GREEN (42) >OUT $NULL (42)
KEY             = q              TRANS           = j

>IN TRANS1.NEIL.GREEN (43) >OUT $NULL (43)
KEY             = r              TRANS           = k

>IN TRANS1.NEIL.GREEN (44) >OUT $NULL (44)
KEY             = s              TRANS           = l

>IN TRANS1.NEIL.GREEN (45) >OUT $NULL (45)
KEY             = t              TRANS           = m

>IN TRANS1.NEIL.GREEN (46) >OUT $NULL (46)
KEY             = u              TRANS           = n

>IN TRANS1.NEIL.GREEN (47) >OUT $NULL (47)
KEY             = v              TRANS           = o

>IN TRANS1.NEIL.GREEN (48) >OUT $NULL (48)
KEY             = w              TRANS           = a

>IN TRANS1.NEIL.GREEN (49) >OUT $NULL (49)
KEY             = x              TRANS           = p

>IN TRANS1.NEIL.GREEN (50) >OUT $NULL (50)
KEY             = y              TRANS           = q

>IN TRANS1.NEIL.GREEN (51) >OUT $NULL (51)
KEY             = z              TRANS           = r

>IN TRANS1.NEIL.GREEN (52) >OUT $NULL (52)
KEY             = 1              TRANS           = 9

>IN TRANS1.NEIL.GREEN (53) >OUT $NULL (53)
KEY             = 2              TRANS           = 8

>IN TRANS1.NEIL.GREEN (54) >OUT $NULL (54)
KEY             = 3              TRANS           = 7

>IN TRANS1.NEIL.GREEN (55) >OUT $NULL (55)
KEY             = 4              TRANS           = 6

>IN TRANS1.NEIL.GREEN (56) >OUT $NULL (56)
KEY             = 5              TRANS           = 5

>IN TRANS1.NEIL.GREEN (57) >OUT $NULL (57)
KEY             = 6              TRANS           = 4

>IN TRANS1.NEIL.GREEN (58) >OUT $NULL (58)
KEY             = 7              TRANS           = 3

>IN TRANS1.NEIL.GREEN (59) >OUT $NULL (59)
KEY             = 8              TRANS           = 2

>IN TRANS1.NEIL.GREEN (60) >OUT $NULL (60)
KEY             = 9              TRANS           = 1

>IN TRANS1.NEIL.GREEN (61) >OUT $NULL (61)
KEY             = /              TRANS           = *

>IN TRANS1.NEIL.GREEN (62) >OUT $NULL (62)
KEY             = &              TRANS           = !

>IN TRANS1.NEIL.GREEN (63) >OUT $NULL (63)
KEY             = .              TRANS           = )

>IN TRANS1.NEIL.GREEN (64) >OUT $NULL (64)
KEY             = "              TRANS           = :

>IN TRANS1.NEIL.GREEN (65) >OUT $NULL (65)
KEY             = _              TRANS           = |

>IN TRANS1.NEIL.GREEN (66) >OUT $NULL (66)
KEY             = -              TRANS           = }

IN=67, OUT=67. CPU-Sec=1. Wall-Sec=1.

rename trans1,translte

I use this file in a table to do the translation:

>BASE STORE,1,WRITER
>get m-product
>TABLE MYTRANS,KEY,FILE,TRANSLTE,DATA(TRANS),HOLD
There are 67 entries in MYTRANS
>DEF A,PRODUCT-DESC[1],1,BYTE
>DEF B,PRODUCT-DESC[2],1,BYTE
>DEF C,PRODUCT-DESC[3],1,BYTE
>DEF D,PRODUCT-DESC[4],1,BYTE
>DEF E,PRODUCT-DESC[5],1,BYTE
>DEF F,PRODUCT-DESC[6],1,BYTE
>DEF G,PRODUCT-DESC[7],1,BYTE
>DEF H,PRODUCT-DESC[8],1,BYTE
>DEF I,PRODUCT-DESC[9],1,BYTE
>DEF J,PRODUCT-DESC[10],1,BYTE
>DEF K,PRODUCT-DESC[11],1,BYTE
>DEF L,PRODUCT-DESC[12],1,BYTE
>DEF M,PRODUCT-DESC[13],1,BYTE
>DEF N,PRODUCT-DESC[14],1,BYTE
>DEF O,PRODUCT-DESC[15],1,BYTE
>DEF P,PRODUCT-DESC[16],1,BYTE
>DEF Q,PRODUCT-DESC[17],1,BYTE
>DEF R,PRODUCT-DESC[18],1,BYTE
>DEF S,PRODUCT-DESC[19],1,BYTE
>DEF T,PRODUCT-DESC[20],1,BYTE
>DEF U,PRODUCT-DESC[21],1,BYTE
>DEF V,PRODUCT-DESC[22],1,BYTE
>DEF W,PRODUCT-DESC[23],1,BYTE
>DEF X,PRODUCT-DESC[24],1,BYTE
>UPDATE
>ext a=$lookup(mytrans,a,trans)
>ext b=$lookup(mytrans,b,trans)
>ext c=$lookup(mytrans,c,trans)
>ext D=$lookup(mytrans,D,trans)
>ext E=$lookup(mytrans,E,trans)
>ext F=$lookup(mytrans,F,trans)
>ext G=$lookup(mytrans,G,trans)
>ext H=$lookup(mytrans,H,trans)
>ext I=$lookup(mytrans,I,trans)
>ext J=$lookup(mytrans,J,trans)
>ext K=$lookup(mytrans,K,trans)
>ext L=$lookup(mytrans,L,trans)
>ext M=$lookup(mytrans,M,trans)
>ext N=$lookup(mytrans,N,trans)
>ext O=$lookup(mytrans,O,trans)
>ext P=$lookup(mytrans,P,trans)
>ext Q=$lookup(mytrans,Q,trans)
>ext R=$lookup(mytrans,R,trans)
>ext S=$lookup(mytrans,S,trans)
>ext T=$lookup(mytrans,T,trans)
>ext U=$lookup(mytrans,U,trans)
>ext V=$lookup(mytrans,V,trans)
>ext W=$lookup(mytrans,W,trans)
>ext X=$lookup(mytrans,X,trans)
>xeq
Update all records from the M-PRODUCT dataset [no]: YES
Warning:  Using DBGET for the input records
IN=13, OUT=13. CPU-Sec=1. Wall-Sec=1.

You can now not really read the data:

>GET M-PRODUCT
>LIST
>XEQ
>GET M-PRODUCT (4) >OUT $NULL (0)
PRODUCT-DESC    = Kdbe 7*2: Nskbstew Kiwwv Drill
PRODUCT-MODEL   = #6523          PRODUCT-NO      = 50531501

>GET M-PRODUCT (39) >OUT $NULL (1)
PRODUCT-DESC    = T!V Jhnmwk
PRODUCT-MODEL   = #7613-04       PRODUCT-NO      = 50522001

>GET M-PRODUCT (49) >OUT $NULL (2)
PRODUCT-DESC    = Kdbe Nsk) Ki) Snmh}Kukhel Saw
PRODUCT-MODEL   = #4560          PRODUCT-NO      = 50533001

>GET M-PRODUCT (50) >OUT $NULL (3)
PRODUCT-DESC    = Kdbe 2 9*8: Ubkunesk Ksa
PRODUCT-MODEL   = #5665          PRODUCT-NO      = 50532501

>GET M-PRODUCT (52) >OUT $NULL (4)
PRODUCT-DESC    = T!V Uhkvewll Kukwavkbowk
PRODUCT-MODEL   = #9018-04       PRODUCT-NO      = 50521001

>GET M-PRODUCT (103) >OUT $NULL (5)
PRODUCT-DESC    = Esdbms 2 9*6: Ubkunesk Kaw
PRODUCT-MODEL   = #5008NB        PRODUCT-NO      = 50512501

>GET M-PRODUCT (146) >OUT $NULL (6)
PRODUCT-DESC    = T!V Nskbstew Kiwwv Bby Kaw
PRODUCT-MODEL   = #7548-04       PRODUCT-NO      = 50523001

>GET M-PRODUCT (164) >OUT $NULL (7)
PRODUCT-DESC    = Esdbms 9*8: Jhnmwk
PRODUCT-MODEL   = #3601B         PRODUCT-NO      = 50512001

>GET M-PRODUCT (171) >OUT $NULL (8)
PRODUCT-DESC    = Esdbms 7*2: Nsk) Kiwwv Vrill
PRODUCT-MODEL   = #DP3730        PRODUCT-NO      = 50511501

>GET M-PRODUCT (221) >OUT $NULL (9)
PRODUCT-DESC    = Kdbe Jhnmwk
PRODUCT-MODEL   = #1835          PRODUCT-NO      = 50532001

>GET M-PRODUCT (231) >OUT $NULL (10)
PRODUCT-DESC    = T!V 3 9*6: Ubkunesk Ksa
PRODUCT-MODEL   = #5728          PRODUCT-NO      = 50522501

>GET M-PRODUCT (241) >OUT $NULL (11)
PRODUCT-DESC    = T!V 7*2: Nskbstew Kiwwv Drill
PRODUCT-MODEL   = #P1149         PRODUCT-NO      = 50521501

>GET M-PRODUCT (243) >OUT $NULL (12)
PRODUCT-DESC    = Esdbms 9: Bby Ksa
PRODUCT-MODEL   = #4300 BV       PRODUCT-NO      = 50513001

IN=13, OUT=13. CPU-Sec=1. Wall-Sec=1.

Then you can reverse the translation file key and translate fields in the table file and reverse them back: I reversed the translate fields:

>BASE STORE,1,WRITER
>get m-product
>TABLE MYTRANS,KEY,FILE,TRANSLTE,DATA(TRANS),HOLD
There are 67 entries in MYTRANS
>DEF A,PRODUCT-DESC[1],1,BYTE
>DEF B,PRODUCT-DESC[2],1,BYTE
>DEF C,PRODUCT-DESC[3],1,BYTE
>DEF D,PRODUCT-DESC[4],1,BYTE
>DEF E,PRODUCT-DESC[5],1,BYTE
>DEF F,PRODUCT-DESC[6],1,BYTE
>DEF G,PRODUCT-DESC[7],1,BYTE
>DEF H,PRODUCT-DESC[8],1,BYTE
>DEF I,PRODUCT-DESC[9],1,BYTE
>DEF J,PRODUCT-DESC[10],1,BYTE
>DEF K,PRODUCT-DESC[11],1,BYTE
>DEF L,PRODUCT-DESC[12],1,BYTE
>DEF M,PRODUCT-DESC[13],1,BYTE
>DEF N,PRODUCT-DESC[14],1,BYTE
>DEF O,PRODUCT-DESC[15],1,BYTE
>DEF P,PRODUCT-DESC[16],1,BYTE
>DEF Q,PRODUCT-DESC[17],1,BYTE
>DEF R,PRODUCT-DESC[18],1,BYTE
>DEF S,PRODUCT-DESC[19],1,BYTE
>DEF T,PRODUCT-DESC[20],1,BYTE
>DEF U,PRODUCT-DESC[21],1,BYTE
>DEF V,PRODUCT-DESC[22],1,BYTE
>DEF W,PRODUCT-DESC[23],1,BYTE
>DEF X,PRODUCT-DESC[24],1,BYTE
>UPDATE
>ext a=$lookup(mytrans,a,trans)
>ext b=$lookup(mytrans,b,trans)
>ext c=$lookup(mytrans,c,trans)
>ext D=$lookup(mytrans,D,trans)
>ext E=$lookup(mytrans,E,trans)
>ext F=$lookup(mytrans,F,trans)
>ext G=$lookup(mytrans,G,trans)
>ext H=$lookup(mytrans,H,trans)
>ext I=$lookup(mytrans,I,trans)
>ext J=$lookup(mytrans,J,trans)
>ext K=$lookup(mytrans,K,trans)
>ext L=$lookup(mytrans,L,trans)
>ext M=$lookup(mytrans,M,trans)
>ext N=$lookup(mytrans,N,trans)
>ext O=$lookup(mytrans,O,trans)
>ext P=$lookup(mytrans,P,trans)
>ext Q=$lookup(mytrans,Q,trans)
>ext R=$lookup(mytrans,R,trans)
>ext S=$lookup(mytrans,S,trans)
>ext T=$lookup(mytrans,T,trans)
>ext U=$lookup(mytrans,U,trans)
>ext V=$lookup(mytrans,V,trans)
>ext W=$lookup(mytrans,W,trans)
>ext X=$lookup(mytrans,X,trans)
>xeq
Update all records from the M-PRODUCT dataset [no]: YES
Warning:  Using DBGET for the input records
IN=13, OUT=13. CPU-Sec=1. Wall-Sec=1.

Now you can re-read the data since you've updated it and reversed the translation:

>GET M-PRODUCT
>LIST
>XEQ
>GET M-PRODUCT (4) >OUT $NULL (0)
PRODUCT-DESC    = Skil 3/8" Variable Speed Drill
PRODUCT-MODEL   = #6523          PRODUCT-NO      = 50531501

>GET M-PRODUCT (39) >OUT $NULL (1)
PRODUCT-DESC    = B&D Router
PRODUCT-MODEL   = #7613-04       PRODUCT-NO      = 50522001

>GET M-PRODUCT (49) >OUT $NULL (2)
PRODUCT-DESC    = Skil Var. Sp. Auto-Scroll Saw
PRODUCT-MODEL   = #4560          PRODUCT-NO      = 50533001

>GET M-PRODUCT (50) >OUT $NULL (3)
PRODUCT-DESC    = Skil 8 1/2" Circular Saw
PRODUCT-MODEL   = #5665          PRODUCT-NO      = 50532501

>GET M-PRODUCT (52) >OUT $NULL (4)
PRODUCT-DESC    = B&D Cordless Screwdriver
PRODUCT-MODEL   = #9018-04       PRODUCT-NO      = 50521001

>GET M-PRODUCT (103) >OUT $NULL (5)
PRODUCT-DESC    = Makita 8 1/4" Circular Saw
PRODUCT-MODEL   = #5008NB        PRODUCT-NO      = 50512501

>GET M-PRODUCT (146) >OUT $NULL (6)
PRODUCT-DESC    = B&D Variable Speed Jig Saw
PRODUCT-MODEL   = #7548-04       PRODUCT-NO      = 50523001

>GET M-PRODUCT (164) >OUT $NULL (7)
PRODUCT-DESC    = Makita 1/2" Router
PRODUCT-MODEL   = #3601B         PRODUCT-NO      = 50512001

>GET M-PRODUCT (171) >OUT $NULL (8)
PRODUCT-DESC    = Makita 3/8" Var. Speed Drill
PRODUCT-MODEL   = #DP3730        PRODUCT-NO      = 50511501

>GET M-PRODUCT (221) >OUT $NULL (9)
PRODUCT-DESC    = Skil Router
PRODUCT-MODEL   = #1835          PRODUCT-NO      = 50532001

>GET M-PRODUCT (231) >OUT $NULL (10)
PRODUCT-DESC    = B&D 7 1/4" Circular Saw
PRODUCT-MODEL   = #5728          PRODUCT-NO      = 50522501

>GET M-PRODUCT (241) >OUT $NULL (11)
PRODUCT-DESC    = B&D 3/8" Variable Speed Drill
PRODUCT-MODEL   = #P1149         PRODUCT-NO      = 50521501

>GET M-PRODUCT (243) >OUT $NULL (12)
PRODUCT-DESC    = Makita 1" Jig Saw
PRODUCT-MODEL   = #4300 BV       PRODUCT-NO      = 50513001

IN=13, OUT=13. CPU-Sec=1. Wall-Sec=1.

So while not really a sophisticated encryption of data it may allow you to mask some important data for test purposes.

Converting Dates from CCYYMMDD to CCYYDDD !!!

Converting Dates from CCYYMMDD to CCYYDDD!

We were recently asked to convert from CCYYMMDD dates to CCYYDDD date, and I came up with the following:

:comment Step One: convert date to have a century field and a begining of year date
in datefile
def boy,1,4,double
def century,1,4,double
item boy,date,ccyymmdd
item mydate,date,ccyymmdd
ext mydate
ext boy=$truncate(a / 10000) * 10000 + 0101
ext century=$truncate(a / 10000)
out workfile,link
xeq

Step Two: Format and determine number of days since Beginning of Year.
in workfile
def newdate,1,4,double
ext mydate
ext boy
ext century
ext diff=$days(mydate) - $days(boy) + 1
ext newdate=(century * 1000) + ($days(a) - $days(boy) + 1)
out convert,link
xeq

You can see the results below including the starting date, you don't need to include all the fields in the result file:

>IN convert (0) >OUT $NULL (0)
MYDATE          = 20141213       BOY             = 20140101
CENTURY         = 2014           DIFF            = 347
NEWDATE         = 2014347

>IN convert (1) >OUT $NULL (1)
MYDATE          = 20131221       BOY             = 20130101
CENTURY         = 2013           DIFF            = 355
NEWDATE         = 2013355

>IN convert (2) >OUT $NULL (2)
MYDATE          = 20150321       BOY             = 20150101
CENTURY         = 2015           DIFF            = 80
NEWDATE         = 2015080

>IN convert (3) >OUT $NULL (3)
MYDATE          = 20100904       BOY             = 20100101
CENTURY         = 2010           DIFF            = 247
NEWDATE         = 2010247

IN=4, OUT=4. CPU-Sec=1. Wall-Sec=1.

The basis of this was to take the current date and make up a second date and make up the Beginning Of Year date, and use $days and get the difference in days between the current date and the Beginning of Year. Thus the "Julian Date" or ccyyDDD, is the current century * 1000, plus the number of days difference (+1) from the beginning of the year.