Stuart Salzer · May 12, 2017 go to post

$ZUTIL(132) or ##CLASS(%Device).ChangePrincipal() have no effect on the parent process. Actually, what do you mean by parent process? If a process is created with a JOB command, while the job ID of of the created process does appear in $ZCHILD, the two processes don't have any lasting parent/child relationship.

Stuart Salzer · May 17, 2017 go to post

The problem is both OPEN statements are for TCP/IP servers. One OPEN has to be a client. You distinguish between the two by giving a DNS or IP address in the OPEN. If everything is running locally, use "127.0.0.1", So

     OPEN dev:("127.0.0.1":33568):3 

Also on one OPEN us are using "\n" for the terminators argument. That makes reads break on backslash and lowercase n. Is that really what you want? This isn't "C". Generally you should specify a mode for TCP/IP I/O. For text based messaging over TCP/IP "PTSE" ≣ "M" works best. Add an "A", that is "MA", for a multi-server. For a binary channel, using mode "S" is still a good idea. Thus:

     OPEN dev:(:33568:"M"):3 ; Open the server.

     OPEN dev:("127.0.0.1":33568:"M"):3 ; Open the client.

Stuart Salzer · Oct 12, 2017 go to post

If you are moving from Caché on OpenVMS to Caché on RHEL 7, you can just move the CACHE.DAT files with FTP. That will move everything globals and data.

You want to have a clean shutdown of Caché before moving the file. You need to use binary FTP. If your OpenVMS system uses MultiNet rather than TCP/IP services for OpenVMS, be warned that the MultiNet FTP server pays attention to the OpenVMS file attributes even on binary transfers, so be sure your CACHE.DAT has RFM:FIX,RAT:NONE, and MRS: and LRL: as some power of 2 between 512 and 16384 (inclusive).

The most common problem, is for customers who previously transitioned from DSM on OpenVMS to Caché on OpenVMS, and used the DSM compatibility $ZF() functions. These do not exist for Caché for other platforms. In fact a few sites, that never used DSM may have discovered these calls, and they may have infiltrated into your code.

Stuart Salzer · Dec 6, 2017 go to post

To the above code:

#Include <stdio.h> /* For snprintf. */

#include <stdarg.h> /* For va_start, va_arg, and va_end. */

Stuart Salzer · Jun 30, 2016 go to post

If you are really sensitive as to not defining new local variables, and having them pollute your variable list, use the variable named % (yes, just a percent sign is a valid variable name, and happens to sort first. Here is the simple case:

    WRITE:$DATA(%) !,"%"
    NEW % SET %="%" FOR SET %=$ORDER(@%) QUIT:%="" WRITE !,%

Putting that into a routine requires one more temporary variable. %0 sorts next, then %00, %000, and so on.

VARLIST() ; SRS 2016-06-30, Returns list of local variables.
    IF $DATA(%) ; This places the existence of variable % into $TEST.
    NEW % SET %=$SELECT($TEST:$LISTBUILD("%"),1:"")
    SET:$DATA(%0) %=%_$LISTBUILD("%0")
    NEW %0 SET %0="%0"
    FOR SET %0=$ORDER(@%0) QUIT:%0="" SET %=%_$LISTBUILD(%0)
    QUIT %

Many programmers consider it acceptable, if not desirable, to use variables %, and % followed by any digits for introspection only, and therefore not worry about if % and %digits are predefined, Using %, %1, %2, %3, etc, and starting loops with SET %="%9" or something like that.

Stuart Salzer · Jul 9, 2016 go to post

How is "best" defined here? If you wan't fastest, and shortest, I have two options for you. This following code also works with both locals and globals, and avoids the bug of using $PIECE() to trim off the global/local name which won't work on globals which contain a "(" in their namespace (admittedly unlikely).

This is the fast version:

        ; $$FDQ($NAME(a),$NAME(b))
        ;       Find first different nodes in two trees (or subtrees). Will
        ;       work with locals or globals, except locals of the form % or
        ;       %<digit>. Returns a string containing the two references where
        ;       the first difference separated by "'=". If a node is found in
        ;       one tree that is not present in the other, the missing
        ;       reference is replaced by a question mark ("?"). If both trees
        ;       are the same, an empty string is returned. 
        ;
FDQ(%1,%2)      ;                                                          [10]
        NEW %3,%4,%5,%6,%7,%8,%9,%0,% ;                                    [20]
        SET %3=$DATA(@%1,%5)#10,%4=$DATA(@%2,%6)#10
        QUIT:%3'=%4||(%3&&(%5'=%6)) $S(%3:%1,1:"?")_"'="_$S(%2:b,1:"?") ;  [30]
        SET %7=%1,%8=%2,%3=$QLENGTH(%1),%4=$QLENGTH(%2)
lq      SET %1=$QUERY(@%1,1,%5),%2=$QUERY(@%2,1,%6) ;                      [40]
        SET:%1'=""&&(%7'=$NAME(@%1,%3)) %1="" ;                            [50]
        SET:%2'=""&&(%8'=$NAME(@%2,%4)) %2=""
        QUIT:%1="" $SELECT(%2="":"",1:"?'="_%2) QUIT:%2="" %1_"'=?" ;      [60]
        FOR %=1:1 SET %9=$QS(%1,%3+%),%0=$QS(%2,%4+%) Q:%9'=%0  Q:%9="" ;  [70]
        IF %9="",%0="" GOTO:%5=%6 lq QUIT %1_"'="_%2 ;                     [80]
        QUIT:%9]]%0 "?'="_%2 QUIT %1_"'=?" ;                               [90]
        ; ------------
        ; [10]  %1,%2 Reference to nodes under test.
        ; [20]  %3,%4 Upto [30] used for Do %1,%2 exist (respectively)?
        ;             After [30] used for count of subscripts of %1,%2.
        ;       %5,%6 Values of %1,%2.
        ;       %7,%8 Copies of %1,%2 used to help find end subtree.
        ;       %9,%0 First different subscript of %1,%2.
        ;       %     Loop index for scanning down subscript list.
        ; [30]  Return if the existence of %1 and %2 differ or if either exist
        ;       (doesn't matter which), and the values differ.
        ; [40]  Go to next node on each side (which we know exist).
        ; [50]  Check if we have moved past the end of the subtree.
        ; [60]  If either or both %1,%2 put us at end of subtree, return.
        ; [70]  Find the first different subscript or both will be "".
        ; [80]  If both final subscripts "", subscripts are the same so check
        ;       values, and either return of loop.
        ; [90]  Subscripts don't match, return determine order so we can return
        ;       node that is missing.
 
This version may take 30% longer in my test runs, but is a lot simpler by using recursion:
        ; $$FDR($NAME(a),$NAME(b))
        ;       Find first different nodes in two trees (or subtrees). Will
        ;       work with locals or globals, except locals of the for %, %1,
        ;       %2, %3, or %4. Returns a string containing the two references
        ;       where the first difference separated by "'=". If a node is
        ;       found in one tree that is not present in the other, the missing
        ;       reference is replaced by a question mark ("?"). If both trees
        ;       are the same, an empty string is returned. 
        ;
FDR(%1,%2)      ;                                                          [10]
        NEW %3,%4,% ;                                                      [20]
        SET %3=$DATA(@%1,%5)#10,%4=$DATA(@%2,%6)#10
        QUIT:%3'=%4||(%3&&(%5'=%6)) $S(%3:%1,1:"?")_"'="_$S(%2:b,1:"?") ;  [30]
        SET (%3,%4)=""
lr      SET %3=$ORDER(@%1@(%3)),%4=$ORDER(@%2@(%4)) Q:%3=""&&(%4="") "" ;  [40]
        IF %3=%4 SET %=$$FDR($NA(@%1@(%3)),$NA(@%2@(%4))) G:%="" lr Q % ;  [50]
        QUIT:%3]]%4 "?'="_$NAME(@%2@(%4)) QUIT $NAME(@%1@(%3))_"'=?" ;     [60]
        ; ------------
        ; [10]  %1,%2 Reference to nodes under test.
        ; [20]  %3,%4 Upto [30] used for Do %1,%2 exist (respectively)?
        ;             After [30] Subscripts of %1,%2.
        ;       %     Results of recursive call.
        ; [30]  Return if the existence of %1 and %2 differ or if either exist
        ;       (doesn't matter which), and the values differ.
        ; [40]  Go to next subscript at this level.
        ; [50]  If the subscripts are the same, check the sub-tree
        ;       recursively. Loop or quit, depending upon finding a difference.
        ; [60]  If subscripts differ, there is a missing node. Return the
        ;       missing one.
Stuart Salzer · Nov 3, 2016 go to post

My colleague provided you a very detailed answer to your first request. That is the “Why” part of your request. For the “How” part, rather than round away the the apparent error that you don’t understand, there is a whole branch of mathematics dealing with transforming your math to make it work on computers. While many programming languages optimize code to correct inefficient logic, few (including COS) will fix your math.

Some, simple examples are:

(1) When adding a vector of floating point numbers, it is wise to sort the numbers by their absolute value, then and add the small numbers to the accumulator first.

(2) When evaluating a polynomial like a·x³+b·x²+c·x+d, rewrite this as ((a·x+b)·x+c)·x+d, and this can be conveniently be written in COS without any parenthesis: SET ans=a*x+b*x+c*x+d

(3) Your problem: Divide last, unless it would cause an overflow. That is if your general equation is (x÷y)·z, why not rewrite it as (x·z)÷y. If (x·z) would cause an overflow, then use either (x÷y)·z, or (z÷y)·x, which ever gives a better answer. The simple way to decide which answer is better, is which answer has the fewest digits after the decimal point. Here is some code if not resorting to rounding is important to you.

MATH    ; SRS 2016-11-03
    FOR {
      READ !,"x/y*z enter: ",t  QUIT:t=""
      SET x=$PIECE(t,"/"),t=$PIECE(t,"/",2)
      SET y=$PIECE(t,"*"),z=$PIECE(t,"*",2)
      IF x'=+x||(y'=+y)||(z'=+z) { SET ans=$CHAR(9785) }
      ELSE {
        TRY { SET ans=x*z/y }
        CATCH e {
          TRY {
        SET xovery=x/y,zovery=z/y
        IF $LENGTH($PIECE(xovery,".",2))<$LENGTH($PIECE(zovery,".",2)) {
          SET ans=xovery*z
        } ELSE {
          SET ans=zovery*x
        }
          CATCH e {
            SET ans=$CHAR(8734)
          }
        }
      }
      WRITE " = ",ans
    }
    QUIT
Stuart Salzer · Nov 16, 2016 go to post

Once your process receives a <STORE> error, it is almost out of memory. It is almost too late for the process to do any self-analysis as to the source of its problem. Still, if you use InterSystems ^%ETN error trap, you might have local variables, and they may show a pattern of waste.

If you believe you know approximately where your local variable waste is located, you can add debug statements like:

SET ^%DEBUG($JOB,$I(^%DEBUG))=$ZDT($H,3,1)_" Now at mumble "_$S

A more advanced approach is to run the code under trace, watching $STORAGE change with each line. Like this:

USER>SET f="/Users/salzer/Desktop/storage.txt"
USER>ZBREAK TRACE:all:f
USER>ZBREAK $:"T"::"WRITE $STORAGE"
USER>DO ^MEMORYLEAK
USER>ZBREAK /TRACE:OFF

Doing this your application will run rather slow. But if it is a batch load, that is fine. Batch loaders don't usually include time-outs. The result is a file that traces your application application and the memory it uses. Here is the start of a program to analyse that trace:

ZSTORE   ; SRS 2016-11-16
   KILL ^||ZSTORE
   SET f="/Users/salzer/Desktop/storage.txt"
   CLOSE f OPEN f:"RS":1 IF '$TEST { WRITE !,"Can't open ",f QUIT }
   USE f SET label="",last=0
   TRY {
     FOR i=0:1 {
       READ x
       IF x["Trace: ZBREAK at " { SET label=$EXTRACT(x,18,*) CONTINUE }
       IF last>0 {
         SET used=x-last,^||ZSTORE(label,$INCREMENT(^||ZSTORE))=used
       }
       SET last=+x
     }
   }
   CATCH err { }
   CLOSE f
   SET label="" WHILE 1 {
     SET label=$ORDER(^||ZSTORE(label)) IF label="" { QUIT }
     WRITE !,label
     SET i="",np=0 FOR n=0:1 {
       SET i=$ORDER(^||ZSTORE(label,i),1,v) IF i="" { QUIT }
       IF v'>0 { CONTINUE }
       IF np=0 { SET min=v,max=v,sum=v,np=1 CONTINUE }
       SET np=np+1
       IF v<min { SET min=v }
       IF v>max { SET max=v }
       SET sum=sum+v
     }
     WRITE " hits:",n IF np'>0 { CONTINUE }
     WRITE " positive:",np," min:",min," max:",max," avg:",sum/np
   }
   QUIT
Stuart Salzer · Mar 22, 2017 go to post

You want to read Appendix B (Calculating System Parameters for UNIX® and Linux) of the Caché Installation Guide, available here: http://docs.intersystems.com/latest/csp/docbook/DocBook.UI.Page.cls?KEY=GCI_unixparms.

Some simple advice that I can add is for routine buffers, this depends upon your application. In general you want to allocate enough routine buffers to contain all the routines that you use on a day to day basis, and not worry about the routines that are only used once a year.

For 2 kio buffers, Do you still have databases with 2 kio blocks? If so, why? If you don't have 2 kio databases, or you can convert them to 8 kio databases, do so, and eliminae the 2 kio database buffers.

For 8 kio buffers, this is usually the big user of memory, and where you get the best boost in performance by adding more memory. By default we take 1/8 of  memory for each Caché configuration, subtract what we need for routine buffers and shared memory heap, and use the rest for 8 kio buffers. If this will be the only instance of Caché on a machine, you can compute this yourself using 1/2 of memory.

You can also decide if you have enough memory for 8 kio buffers, by just monitoring the performance of your database. Just look at Cache efficiency. (Global References/(Disk Reads+Disk Writes)). The high the better. Keep adding memory until the improvement is not significant, or you run into some other problem.

Stuart Salzer · Mar 23, 2017 go to post

I have no idea what your code is really trying to do. Some comments would be helpful. Même un commentaire en français serait utile. In addition to adding parenthesis needed because COS does not have operator precedence. Also,

1. $a($e(string,i)) is unnecessary, $a(string,i) does the same thing.

2. You are obviously doing some kind of translation. Look at $ZCONVERT() in the documentation.

3. For other simple translation, $TRANSLATE() is a simple solution. For example if you have old data in AFNOR NF Z 62010-1982, you could translate it to Unicode with $TRANSLATE(string,"#'@[\]`{|}~","£’à°ç§µéùè¨").

Stuart Salzer · May 12, 2017 go to post

IJC devices work! They come in pairs, and all may not be defined on your system. Start at the beginning and try writing to 225 and reading from 224. Each process must OPEN their devices before reading or writing. You get to write a certain amount to 225 before the device blocks. The reader can read with a zero second time-out, if you don't want the reader waiting. 

In the system management portal goto
System Administration → Configuration → Additional Settings → Advanced Memory. ijcbuff controls the amount of memory per IJC device. The bigger the more you can write to an IJC device with an lagging reader, before the device blocks. ijcnum is the number of defined IJC device pairs.

Calling $ZUTIL(132) with no extra arguments makes the current device the principal device. It was documented in the Caché ObjectScript Language Reference up until Caché 2009.1. It has been replaced with ##CLASS(%Device).ChangePrincipal(), which does the same thing. This isn't typically very useful.

Often more useful is the former $ZUTIL(82,12,bool), now ##CLASS(%Device).ReDirectIO(bool) which lets you redirect I/O through routines that can filter, redirect, record, though routines. Unfortunately, while the workings of $ZUTIL(82,12,bool) did eventually make it into the documentation, the workings were removed from the ##CLASS(%Device).ReDirectIO(bool) documentation. The details are the same, look at the old documentation on-line.

Stuart Salzer · Jun 1, 2017 go to post

How about this, call with

    DO ^GETTREE("/home/user/dir/*",.result)
    and $ORDER() through result.

#INCLUDE %sySite
GETTREE(wild,result)    ;
    NEW (wild,result)
    SET s=$SELECT($$$ISUNIX:"/",$$$ISWINDOWS:"\",1:1/0)    ; separator
    SET w=$SELECT($$$ISUNIX:"*",$$$ISWINDOWS:"*.*")        ; wild-card
    SET todo(wild)=""
    FOR {
      SET q=$ORDER(todo("")) QUIT:q=""  KILL todo(q)
      SET f=$ZSEARCH(q) WHILE f'="" {
        SET t=$PIECE(f,s,$LENGTH(f,s)) QUIT:t="."  QUIT:t=".."
        SET result(f)=""
        SET todo(f_s_w)=""
        SET f=$ZSEARCH("")
      }
    }
    QUIT

Flaws:
On my mac, I have some directories so deep, $ZSEARCH() fails.
It doesn't work on OpenVMS. As much as you may want to think that you can convert dev:[dir]subdir.DIR;1 to dev:[dir.subdir]*.*;*, and keep searching, there are too many weird cases to deal with on OpenVMS, better to just write a $ZF() interface to LIB$FIND_FILE() and LIB$FIND_FILE_END().

Stuart Salzer · Oct 30, 2017 go to post

I use 

QUOTE(x) QUIT $EXTRACT($NAME(%(x)),3,*-1)

to quote a string, so just removing the leading and trailing quote is what you want, or

DupQuote(x) QUIT $EXTRACT($NAME(%(x)),4,*-2)

Stuart Salzer · Nov 30, 2017 go to post

JSON format is probably the most general. Return the values in a JSON formatted string. Then parse with

    SET objresult=##CLASS(%DynamicObject).%FromJSON(result)

However, if you want to return a simple structure. That is two or a few values, where no values are themselves structures, and nature of the data is easily understood, you could return the values as an artificial local reference, and take the value apart with $QSUBSCRIPT() is COS. This function would prove handy for such an option.

/* This function adds %q to snprintf() to print a quoted string. */
int varcosreturn (char *buffer, size_t len, char *fmt, ...) {
   va_list ap;
   char *p, *q, *r;
   char c;
   size_t n;
   char xfmt [3];

   va_start(ap, fmt);
   p = buffer; q = fmt;
   for (;;) {
      c = *q++;
      if (c == '\0') break;
      if (c != '%') { if (len==0) break; --len; *p++ = c; continue; }
      c = *q++;
      if (c == 'q') {
         if (len==0) break; --len; *p++ = '\"';
         r = va_arg(ap,char*);
         for (;;) {
            c = *r++;
            if (c == '\0') break;
            if (c == '\"') { if (len==0) break; --len; *p++ = '\"'; }
            if (len==0) break; --len; *p++ = c;
         }
         if (len==0) break; --len; *p++ = '\"';
         continue;
      }
      xfmt [0] = '%'; xfmt [1] = c; xfmt [2] ='\0';
      n = snprintf (p, len, xfmt, va_arg(ap, void*));
      len -= n; p += n;
   }
   va_end(ap);
   if (len==0) return -1; --len; *p++ = '\0';
   return 0;
}

$LISTBUID() format is not doucmented so that InterSystems can later expand (or change) it.

Stuart Salzer · Jan 2, 2018 go to post

There is nothing built into Caché to get a updating virtual terminal window size like you would have with ncurses. You could...

(1) Write the terminal portions of you application in a language with ncurses support (like "C"), and then use either call-in or call-out to combine the ncurses portions of your application with the COS portions. Call-in would probably be easier.

(2) If you can live without an automated update, the traditional solution is to assign a key in your application to repaint the screen after modem line noise (remember that) messed-up the screen. Traditionally, that was <CTRL+R>. You could just add to the work done by <CTRL+R> to be.
    (a) Clear the screen.
    (b) Position the cursor at the lower right hand corner.
    (c) Clear the typeahead buffer.
    (d) Ask the terminal were its cursor is.
    (e) Read, and parse the Cursor Position Report.
    The position of the cursor is the window size.
    (f) Repaint the screen at its current size.
Step (a) could be moved later in the sequence if you like.
Steps (b) and (c) can be reversed.

If you only care about supporting modern terminal emulators, all of which emulate VT-100+ terminals, the code is

    ;(a) Clear the screen
    WRITE $CHAR(27),"[H"
    ;(b) Positions the cursor at the lower right hand corner.
    WRITE $CHAR(27)_"[255;255H"
    ;(c) Clear the typeahead buffer.
    WRITE *-1
    ;(d) Ask the terminal where its cursor is:
    ;Use this routine
FC()    NEW
    SET result=0 FOR j=1:1:4 DO  QUIT:result  ;             [10]
    . WRITE $CHAR(27)_"[6n" ;                               [20]
    . READ junk:j QUIT:'$TEST  QUIT:$ASCII($KEY)'=27  ;     [30]
    . QUIT:$EXTRACT($KEY,2)'="["  QUIT:$EXTRACT($KEY,*)'="R"
    . SET $Y=$EXTRACT($KEY,3,*)-1,$X=$PIECE($KEY,";",2)-1 ; [40]
    . SET result=1
    QUIT result
    ; ------------
    ; [10] Assume failure. Try four times (with increasing
    ;      timeout) to determine the location of the cursor.
    ;      Quit early on success.
    ; [20] Send where is the cursor (DSR Device Status Request).
    ; [30] Read result, CPR (Cursor Position Report). We must
    ;      get it, and it must be of form "<ESC>[#,#R".
    ; [40] Extract $Y and $X from the CPR (Cursor Position
    ;      Report), and call it a success.
    ;(e) Repaint the screen at its current size.
    ; That is up to you.
Stuart Salzer · Dec 6, 2018 go to post

Your question does not say the format of the dates. I am answering based upon dd-mm-yyyy, but it is easy enough to change for a different date format.  The big mistake in all prior answers is that they contain small errors around leap years. To compute the number of years between to dates in $HOROLOG format use $ZDATE(date2,8)-$ZDATE(date1,8)\10000.

So:

UNDER2    ; SRS 2018-12-06
    SET today=$ZDATE($HOROLOG,8)
    SET name=""
    WHILE 1 {
      SET name=$ORDER(^checker("under2",name)) QUIT:name=""  ;        [1]
      SET birthday=$ORDER(^checker("under2",name,"")) ;               [2]
      SET birthday=$ZDATEH($TRANSLATE(birthday,"-","/"),4,,,,,,,"") ; [3]
      CONTINUE:birthday=""  ;                                         [4]
      SET age=today-$ZDATE(birthday,8)\10000 ;                        [5]
      CONTINUE:age'<2  ;                                              [6]
      WRITE !,name,?22,age," ",$ZDATE(birthday,4,,4) ;                [7]
    }
    QUIT

 

[1] Advance to next name.

[2] Get the first birthday. The structure allows multiple birthdays, but the code only looks at the first birthday.

[3] Convert the birthday from dd-mm-yyyy format to $HOROLOG format.

[4] Skip badly formatted birthdays.

[5] Compute the age in whole years.

[6] Skip people whose age is >= 2.

[7] Do something with people whose age is less than 2.

Stuart Salzer · Jun 19, 2019 go to post

In most recent versions of Caché, we install a directory dev/cache/callout/demo. This contains demonstration code  for writing $ZF() functions. One of the examples is tzchange(), and it works by setting a environment variable in the current process, and it should be easy enough to adapt to your needs. Start by reading czf.pdf.

Stuart Salzer · Jul 15, 2019 go to post

I wrote this a while ago. Just ran on a MacBook Pro Mid 2015, 2.8 GHz Intel Core i7.

It computed the first 1000 digits in less than 1 minute, 2000 digits in 5 minute, 3000 digits, in 14 minute, 4000 digits in 32 minute, 5000 digits in 60 minute...

PI    ; SRS 2011-07-18
    ; Compute PI using Plouffe and Bellard algorithm, based upon "C" code
    ; found at <http://iweb.dl.sourceforge.net/project/projectpi/
    ; Digit%20Extraction%20Methods/Plouffe%20and%20Bellard%20v1/pi1_f.c>.
    KILL ^PI,^PRIME
    SET ^PI=-1
    FOR I=0:1:9 JOB C($INCREMENT(^PI))
    QUIT
C(p)    NEW $ETRAP SET $ETRAP="DO ^%ETN"
    SET n=p*9+1
    SET bign=+$TRANSLATE(n+20*$ZLN(10)/$ZLN(2),".","!")
    SET sum=0
    SET a=3 FOR  QUIT:a>(2*bign)  DO  SET a=$$NP(a)
    . SET vmax=+$PIECE($ZLN(2*bign)/$ZLN(a),".")
    . SET av=1 FOR i=1:1:vmax SET av=av*a
    . SET s=0,num=1,den=1,v=0,kq=1,kq2=1
    . FOR k=1:1:bign DO
    . . SET t=k
    . . IF kq'<a FOR  SET t=t\a,v=v-1 IF t#a SET kq=0 QUIT
    . . SET kq=kq+1,num=num*t#av
    . . SET t=2*k-1
    . . DO:kq2'<a 
    . . . IF kq2=a FOR  SET t=t\a,v=v+1 QUIT:t#a
    . . . SET kq2=kq2-a
    . . SET den=den*t#av,kq2=kq2+2
    . . DO:v>0
    . . . SET t=$$IM(den,av),t=t*num#av,t=t*k#av
    . . . FOR i=v+1:1:vmax SET t=t*a#av
    . . . SET s=s+t
    . . . SET:s'<av s=s-av
    . SET t=$$PM(10,n-1,av),s=s*t#av
    . SET sum=sum+(s/av),sum=+("."_$PIECE(sum,".",2))
    SET ^PI(p)=$EXTRACT($PIECE(sum,".",2)_"000000000",1,9)
    JOB C($INCREMENT(^PI))
    QUIT
NP(a)    NEW (a) FOR  SET r=$ORDER(^PRIME(a)) QUIT:r'=""  DO  QUIT:r'=""
    . LOCK ^PRIME 
    . SET r=$ORDER(^PRIME(a)) IF r'="" LOCK  QUIT
    . IF $DATA(^PRIME)=0 SET ^PRIME=3,^PRIME(2)="",^PRIME(3)="" LOCK  QUIT
    . FOR r=^PRIME:2 DO  IF pr SET ^PRIME(r)="" QUIT:r>a
    . . SET pr=1 FOR p=3:2:$ZSQR(r) IF r#p=0 SET pr=0 QUIT
    . SET ^PRIME=r
    . LOCK
    QUIT r
IM(x,y)    NEW (x,y)
    SET u=x,v=y,c=1,a=0
    FOR  SET q=v\u,t=c,c=a-(q*c),a=t,t=u,u=v-(q*u),v=t QUIT:u=0
    SET a=a#y
    SET:a<0 a=a+y
    QUIT a
PM(a,b,m)    NEW (a,b,m)
    SET r=1,aa=a
    FOR  SET:b#2 r=r*aa#m SET b=b\2 QUIT:b=0  SET aa=aa*aa#m
    QUIT r
 

Stuart Salzer · Jun 23, 2021 go to post

Yes, but it is unsupported. The expression $ZUTIL(70,2,value) will return value encoded for use as a subscript subject to the current default subscript encoding. You can combine this with $LENGTH(), so $LENGTH($ZUTIL(70,2,value)) to get the length of a subscript once encoded. This technique should never find its way into production code. However, if you just want to understand how various codepoints are encoded, you can use it for experimentation.

Stuart Salzer · Sep 13, 2021 go to post

Instead of using the first piece with $PIECE(variable,"("), I recommend using $NAME(@variable,0). $NAME has the advantage that it will likely be updated in the event of any changes to introduce new variable syntax, while $PIECE(variable,"(") will remain stuck with the simple syntax. One advantage of $NAME(@varaible,0) is that $NAME will also check the syntax of all the subscripts. One disadvantage is that all subscripts must be defined.

Stuart Salzer · Sep 15, 2021 go to post

If you don't want to mess with SQL functions, this is still easy, especially taking advantage of date format 8 (ANSI):

DOM    ; SRS 2021-09-15 PUBLIC DOMAIN NO WARRENTY
    ; Return $HOROLOG date for first day of the month.
FIRST(y,m)    QUIT $ZDATEH(y*100+m*100+1,8)
    ; Return $HOROLOG date for last day of the month.
LAST(y,m)    SET m=m+1 SET:m>12 m=m-12,y=y+1
    QUIT $ZDATEH(y*100+m*100+1,8)-1

Test for this year with:

USER>FOR i=1:1:12 WRITE !,i," ",$$FIRST^DOM(2021,i)," ",$$LAST^DOM(2021,i)

1 65745 65775
2 65776 65803
3 65804 65834
4 65835 65864
5 65865 65895
6 65896 65925
7 65926 65956
8 65957 65987
9 65988 66017
10 66018 66048
11 66049 66078
12 66079 66109

Stuart Salzer · Dec 6, 2021 go to post

If you are to store the encrypted identifiers in the database, database block encryption is your answer, but if you need to transmit them securely, before encrypting or hashing something as small as a nine-digit number add some salt. That is add enough random digits or letters to make a brute force attack unfeasible. Since you presumably want to be able to later decode these identifiers, use encryption in your case.

Stuart Salzer · Feb 5, 2022 go to post

If you are trying to run arbitrary code from a Windows .BAT file, the following almost works:

ECHO ZN "%%SYS" DO ^^^^SECURITY HALT | C:\InterSystems\Cache\bin\cache.exe -s C:\InterSystems\Cache\mgr

The limitations are:

  • You have to specify the locations of the Caché or IRIS executable and the \mgr directory with an -s option.
  • One cannot redirect command input from the terminal, so what you run can't be interactive.
  • Quoting for Windows may annoy you.
Stuart Salzer · Jul 12, 2023 go to post

Although the interface is clunky for looking through large journal files, the startup cost is negligible:

%SYS>DO ^JRNDUMP

Select "G" for Goto

File: enter your filename which doesn't have to be and shouldn't be in the main journal directory.

At this point the interface is limited, but "F" for Find might help.

Stuart Salzer · Aug 16, 2024 go to post

A simpler solution than using SET rs=##CLASS(%ResultSet).%New("%File:FileSet"), is the $ZSEARCH() function:

    SET f=$ZSEARCH(SDIR)
    WHILE f'="" {
        // Do something with f
        SET f=$ZSEARCH(f)
    }

There is no need to create a child process or use classes.

Stuart Salzer · Sep 18, 2024 go to post

If you want to wait for a group of child jobs to finish, you can do this with simple (incremental) locks:

Each child begins with:

    LOCK +^JOIN($JOB) SET ^JOIN($JOB)=$HOROLOG

and ends with:

    KILL ^JOIN($JOB) LOCK -^JOIN($JOB)

The parent can test that all the children have finished with:

    LOCK ^JOIN

    IF $DATA(^JOIN)=0 WRITE !,"One of the children died!"

There are lots of ways to expand on this. Add timeouts on the locks. Add a subscript before $JOB in whatever global you use to communicate the process join to have multiple simultaneous process joins. The parent can also look inside the ^JOIN global to diagnose which process died and possibly restart it.