NVSLOOP.m

NVSLOOP ;WJW@OIOFO for CACHE ;1/3/05 mod: 2/24/05

 ;;1.5;NVS works with "%" subscripts now

 ;Credit to "The Highly Esteemed Kevin Kearney" for starting the routine

 ;Loops through global to determine how many nodes exist

 ;

 ; -- added to NVSMENU KIDs BUILD  jls/oiofo         1/21/06  NOON

 ;

 S U="^"

 S:'$D(DTIME) DTIME=300

LMT R !,"Enter Threshold to report: 500// ",NVSLMT:DTIME

 G:$T=0 EXIT

 G:NVSLMT[U EXIT

 I NVSLMT="" S NVSLMT=500 G GBL

 I NVSLMT["?" D HELPL G LMT

 G:+NVSLMT'>0 EXIT

GBL R !,"Enter 1 for TMP, 2 for XTMP, 3 for Custom: 2// ",NVSGBL:DTIME

 G:$T=0 EXIT

 G:NVSGBL[U EXIT

 I NVSGBL="2" S NVSGBL=2,NVSGBR="^XTMP" G SUBS

 I NVSGBL="" S NVSGBL=2,NVSGBR="^XTMP" G SUBS

 I NVSGBL["?" D HELP G GBL

 I NVSGBL=1 S NVSGBR="^TMP" G SUBS

 I NVSGBL=3 R !,"Enter global in ^NAME format: ",NVSGBR:DTIME

 G:$T=0 EXIT

 I NVSGBR'[U W !!,"Global must start with ^ ",! G GBL

 G:$L(NVSGBR)=1 EXIT

 I NVSGBR["(" W !!,"Subscripts not allowed",! G GBL

 I '$D(@NVSGBR) W !!,"Global does not exist.  Please try again.",! G GBL

SUBS W !,"Do you want counts on 2nd level subscript also" S %=1 D YN^DICN

 G:%<0 EXIT

 S NVSCKSUB=%

 S %ZIS="Q" D ^%ZIS

 G:IO="" EXIT

 D:$D(IO("Q"))

 .S ZTRTN="MAIN^NVSLOOP",ZTION=ION,ZTDESC="NVSLOOP "_NVSGBR

 .S ZTSAVE("NVS*")="" D ^ZTLOAD W !!,*7,"REQUEST (",ZTSK,") QUEUED!!"

 G:$D(IO("Q")) EXIT

MAIN U IO W !,"Working...",!

 s ref=NVSGBR

 s tot=0

 D TOTAL,SUBTOT

 D:NVSCKSUB=1 SUBTOT2

 D ^%ZISC

EXIT K ref,tot,oref,Z,x,I,Y,X,NVSGBR,NVSGBL,NVSLMT,NVSCKSUB

 Q

TOTAL f x=0:0 s ref=$Q(@ref) q:ref=""  s tot=tot+1

 U IO W !,"TOTAL NODES ","= ",tot,!

 Q

SUBTOT ;total by first level subscript.

 S I=-1

 F  S Y=NVSGBR_"("_""""_I_""""_")",I=$O(@Y) Q:I=""  D

 . s:($A(I,1)>57)!($A(I,1)<48) ref=NVSGBR_"("_""""_I_""""_")"

 . s:($A(I,1)<58)&($A(I,1)>47) ref=NVSGBR_"("_I_")"

 . s Z=0,oref=$e(ref,1,$l(ref)-1)

 . f x=0:0 s ref=$Q(@ref) q:ref'[oref  D

 .. s Z=(Z+1)

 . i Z>NVSLMT U IO w ! D ^%T w ": ",oref," has "_Z_" nodes."

 Q

SUBTOT2 ;total by 2nd level subscript

 U IO W !!!,?40,"Working on 2nd level Subscripts....",!!!

 S I=-1

 S Y=NVSGBR_"("_""""_I_""""_")",I=$O(@Y) Q:I=""

 s:($A(I,1)>57)!($A(I,1)<48) ref=NVSGBR_"("_""""_I_""""_")"

 s:($A(I,1)<58)&($A(I,1)>47) ref=NVSGBR_"("_I_")"

 D

 . F  Q:ref=""  s X=$e(ref,1,$l(ref)-1)_",-1)" S X=$Q(@X) Q:X=""  D

 .. s Z=1,oref=$P(ref,",",1,2)

 .. ;W !,"x= ",X,?20,"ref= ",ref,?40,"oref= ",oref,?60,"I= ",I

 .. f x=0:0 s ref=$Q(@ref) q:ref'[oref  D

 ... ;W !,"ref= ",ref,?40,"oref= ",oref

 ... s Z=(Z+1)

 ... q

 .. i Z>NVSLMT U IO w ! D ^%T w ": ",oref," has "_Z_" nodes."

 .. q

 .

 Q

HELP ;

 W !!,"This routine loops through globals to count the number"

 W !,"of nodes.  It gives a Grand Total, Total for each top"

 W !,"level subscript, and a Total for each second level."

 W !,"Enter 1 to check ^TMP, 2 to check ^XTMP, or 3 to enter"

 W !,"a global of your choice.  You must enter the ^ and it"

 W !,"must be the global name only, no subscripts allowed."

 W !!,"You can queue the output to a printer or HFS device.",!

 Q

HELPL ;

 W !!,"This number is used to limit the amount of output. Only"

 W !,"those first and second level subsripts with this number"

 W !,"of nodes will be reported.",!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---NVSLOOP   3253     printed  Apr 09, 2024@21:20:35                                                                                                                                                                                                     Page 2

NVSLOOP   ;WJW@OIOFO for CACHE ;1/3/05 mod: 2/24/05

 +1       ;;1.5;NVS works with "%" subscripts now

 +2       ;Credit to "The Highly Esteemed Kevin Kearney" for starting the routine

 +3       ;Loops through global to determine how many nodes exist

 +4       ;

 +5       ; -- added to NVSMENU KIDs BUILD  jls/oiofo         1/21/06  NOON

 +6       ;

 +7        SET U="^"

 +8        if '$DATA(DTIME)

               SET DTIME=300

LMT        READ !,"Enter Threshold to report: 500// ",NVSLMT:DTIME

 +1        if $TEST=0

               GOTO EXIT

 +2        if NVSLMT[U

               GOTO EXIT

 +3        IF NVSLMT=""

               SET NVSLMT=500

               GOTO GBL

 +4        IF NVSLMT["?"

               DO HELPL

               GOTO LMT

 +5        if +NVSLMT'>0

               GOTO EXIT

GBL        READ !,"Enter 1 for TMP, 2 for XTMP, 3 for Custom: 2// ",NVSGBL:DTIME

 +1        if $TEST=0

               GOTO EXIT

 +2        if NVSGBL[U

               GOTO EXIT

 +3        IF NVSGBL="2"

               SET NVSGBL=2

               SET NVSGBR="^XTMP"

               GOTO SUBS

 +4        IF NVSGBL=""

               SET NVSGBL=2

               SET NVSGBR="^XTMP"

               GOTO SUBS

 +5        IF NVSGBL["?"

               DO HELP

               GOTO GBL

 +6        IF NVSGBL=1

               SET NVSGBR="^TMP"

               GOTO SUBS

 +7        IF NVSGBL=3

               READ !,"Enter global in ^NAME format: ",NVSGBR:DTIME

 +8        if $TEST=0

               GOTO EXIT

 +9        IF NVSGBR'[U

               WRITE !!,"Global must start with ^ ",!

               GOTO GBL

 +10       if $LENGTH(NVSGBR)=1

               GOTO EXIT

 +11       IF NVSGBR["("

               WRITE !!,"Subscripts not allowed",!

               GOTO GBL

 +12       IF '$DATA(@NVSGBR)

               WRITE !!,"Global does not exist.  Please try again.",!

               GOTO GBL

SUBS       WRITE !,"Do you want counts on 2nd level subscript also"

           SET %=1

           DO YN^DICN

 +1        if %<0

               GOTO EXIT

 +2        SET NVSCKSUB=%

 +3        SET %ZIS="Q"

           DO ^%ZIS

 +4        if IO=""

               GOTO EXIT

 +5        if $DATA(IO("Q"))

               Begin DoDot:1

 +6                SET ZTRTN="MAIN^NVSLOOP"

                   SET ZTION=ION

                   SET ZTDESC="NVSLOOP "_NVSGBR

 +7                SET ZTSAVE("NVS*")=""

                   DO ^ZTLOAD

                   WRITE !!,*7,"REQUEST (",ZTSK,") QUEUED!!"

               End DoDot:1

 +8        if $DATA(IO("Q"))

               GOTO EXIT

MAIN       USE IO

           WRITE !,"Working...",!

 +1        SET ref=NVSGBR

 +2        SET tot=0

 +3        DO TOTAL

           DO SUBTOT

 +4        if NVSCKSUB=1

               DO SUBTOT2

 +5        DO ^%ZISC

EXIT       KILL ref,tot,oref,Z,x,I,Y,X,NVSGBR,NVSGBL,NVSLMT,NVSCKSUB

 +1        QUIT 

TOTAL      FOR x=0:0

               SET ref=$QUERY(@ref)

               if ref=""

                   QUIT 

               SET tot=tot+1

 +1        USE IO

           WRITE !,"TOTAL NODES ","= ",tot,!

 +2        QUIT 

SUBTOT    ;total by first level subscript.

 +1        SET I=-1

 +2        FOR 

               SET Y=NVSGBR_"("_""""_I_""""_")"

               SET I=$ORDER(@Y)

               if I=""

                   QUIT 

               Begin DoDot:1

 +3                if ($ASCII(I,1)>57)!($ASCII(I,1)<48)

                       SET ref=NVSGBR_"("_""""_I_""""_")"

 +4                if ($ASCII(I,1)<58)&($ASCII(I,1)>47)

                       SET ref=NVSGBR_"("_I_")"

 +5                SET Z=0