%INDX6 ;ISC/REL,GRK - GET SET OF ROUTINES TO INDEX ;8/3/93 16:10 ;
;;7.3;TOOLKIT;;Apr 25, 1995
;INP(1=Print more than warnings, 2= Print routines, 3= Print warnings, 4= Print DDs & Functions & Options, 5= Type of List, 6= Summary only, 7= Save Parameters
;INP(8= Index called routines, 9= Include the Compiled template routines
D HOME^%ZIS,HDR S:'$D(DTIME)#2 DTIME=360
K ^UTILITY($J),ZTSK,ZTDTH,ZTIO D ASKRTN S Q="""",RTN=0 F I=1:1:10 S INP(I)=0
S INDDA=0 I $D(^DIC(9.4)) D ^%INDX10 G END:$D(DUOUT) S INDDA=DA I DA>0 D ANS("Include the compiled template routines: N//","NY") G:X="^" END S:"Nn"'[X INP(9)=1
G END:(NRO'>0)&(INDDA'>0)
D ANS("Print more than compiled errors and warnings? YES//","YN","Print detailed info") G:X="^" END S INP(1)="Yy"[X G:'INP(1) L7
D ANS("Print summary only? NO//","NY","Skip detail on each routine") G:X="^" END S INP(6)="Yy"[X G L7:INP(6)
D ANS("Print routines? YES//","YN","Print routines code also") G:X="^" END S INP(2)="Yy"[X
I INP(2) D ANS("Print (R)egular,(S)tructured or (B)oth? R//","RLIST") G:X="^" END S INP(5)=X
I INDDA>0 D ANS("Print the DDs, Functions, and Options? YES//","YN","Gather other package code.") G:X="^" END S INP(4)="Yy"[X
D ANS("Print errors and warnings with each routine? YES//","YN") G:X="^" END S INP(3)="Yy"[X
L7 I $D(^DIC(9.8,0)) D ANS("Save parameters in ROUTINE file? NO//","NY","Update the ROUTINE file with details") G:X="^" END S INP(7)="Yy"[X
D ANS("Index all called routines? NO//","NY","Add called routines") G:X="^" END S INP(8)="Yy"[X
DEVICE W:NRO>2 !!,$C(7),"This report could take some time, Remember to QUEUE the report.",! K IOP,%ZIS S %ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP W !,*7,"%INDEX terminated. No device specified." G END
;S IOP=ION_";"_IOST_$S($D(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
I IO=IO(0),"C"[$E(IOST),$D(IO("Q"))#2 W !,"Do you really mean queue to this device? NO//" D NY I "Nn"[X W !!,"Ok, tell me again ..." K IO("Q") D ^%ZISC G DEVICE
;I IO'=IO(0),'$D(IO("Q")) W !!,"I am QUEUEING this report for you." S IO("Q")=1
I '$D(IO("Q")) G ALIVE^%INDEX
S ZTRTN="ALIVE^%INDEX",ZTDESC="%INDEX of "_NRO_" routine"_$S(NRO>1:"s.",1:".") F G="INP(","INDDA","^UTILITY($J,","NRO","INDPM" S ZTSAVE(G)=""
K IO("Q") D ^%ZTLOAD,HOME^%ZIS
END K ZTSK,%ZIS G CLEAN^%INDX5
ANS(PR,DEF,HELP) ;Ask question get answer
N % F S Y=1 W !!,PR D @DEF Q:Y
Q
YN S %="Y" D RD Q:"^YyNn"[X W:$D(HELP) !,HELP W !,"Please enter 'Y' or return for YES, 'N' for NO" S Y=0 Q
NY S %="N" D RD Q:"^YyNn"[X W:$D(HELP) !,HELP W !,"Please enter 'N' or return for NO, 'Y' for YES" S Y=0 Q
RD R X:DTIME S:X["^" X="^" S X=$E(X_%) Q
RLIST S %="R" D RD Q:"^RSBF"[X W !,"Please select one of the choices." S Y=0 Q
Q
ASKRTN ;Collect a list of routines to index.
I $D(^%ZOSF("RSEL")) X ^("RSEL") S NRO=0,X=0 F I=0:0 S X=$O(^UTILITY($J,X)) Q:X="" S NRO=NRO+1
Q
W !!,"LIST OF ROUTINES TO BE INDEXED; PRESS RETURN TO TERMINATE LIST",! S NRO=0
R1 R !,"ROUTINE NAME: ",ROU:$S($G(DTIME):DTIME,1:360) Q:ROU=""
I ROU'?1"%".UN&(ROU'?1U.UN) W " INVALID ROUTINE NAME" G R1
I $D(^%ZOSF("TEST")) S X=ROU X ^("TEST") E W " INVALID ROUTINE NAME" G R1
S NRO=NRO+1,^UTILITY($J,ROU)="" G R1
SETUP ;Write startup header stuff.
U IO D HDR
S Q="""",U="^",INDDS=0,RTN="$",DA=INDDA,IND("TM")=$H I INDDA>0 D START^%INDX10 D:IOSL\2<$Y HDR W !!,"Routines are being processed.",!
W "Indexed Routines: ",NRO,!!
Q
HDR D NOW^%DTC S Y=%,DT=$P(Y,".",1) D DD^%DT S INDXDT=Y X ^%ZOSF("UCI") S INDHDR(1)="UCI: "_$P(Y,",")_" CPU: "_^%ZOSF("VOL")_" "_INDXDT,INDHDR="V. A. C R O S S R E F E R E N C E R "_$P($T(+2),";",3)
W:$Y>3 @IOF W !!,?IOM-$L(INDHDR)\2,INDHDR,!,?IOM-$L(INDHDR(1))\2,INDHDR(1),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZINDX6 3715 printed Dec 13, 2024@02:42:39 Page 2
%INDX6 ;ISC/REL,GRK - GET SET OF ROUTINES TO INDEX ;8/3/93 16:10 ;
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 ;INP(1=Print more than warnings, 2= Print routines, 3= Print warnings, 4= Print DDs & Functions & Options, 5= Type of List, 6= Summary only, 7= Save Parameters
+3 ;INP(8= Index called routines, 9= Include the Compiled template routines
+4 DO HOME^%ZIS
DO HDR
if '$DATA(DTIME)#2
SET DTIME=360
+5 KILL ^UTILITY($JOB),ZTSK,ZTDTH,ZTIO
DO ASKRTN
SET Q=""""
SET RTN=0
FOR I=1:1:10
SET INP(I)=0
+6 SET INDDA=0
IF $DATA(^DIC(9.4))
DO ^%INDX10
if $DATA(DUOUT)
GOTO END
SET INDDA=DA
IF DA>0
DO ANS("Include the compiled template routines: N//","NY")
if X="^"
GOTO END
if "Nn"'[X
SET INP(9)=1
+7 if (NRO'>0)&(INDDA'>0)
GOTO END
+8 DO ANS("Print more than compiled errors and warnings? YES//","YN","Print detailed info")
if X="^"
GOTO END
SET INP(1)="Yy"[X
if 'INP(1)
GOTO L7
+9 DO ANS("Print summary only? NO//","NY","Skip detail on each routine")
if X="^"
GOTO END
SET INP(6)="Yy"[X
if INP(6)
GOTO L7
+10 DO ANS("Print routines? YES//","YN","Print routines code also")
if X="^"
GOTO END
SET INP(2)="Yy"[X
+11 IF INP(2)
DO ANS("Print (R)egular,(S)tructured or (B)oth? R//","RLIST")
if X="^"
GOTO END
SET INP(5)=X
+12 IF INDDA>0
DO ANS("Print the DDs, Functions, and Options? YES//","YN","Gather other package code.")
if X="^"
GOTO END
SET INP(4)="Yy"[X
+13 DO ANS("Print errors and warnings with each routine? YES//","YN")
if X="^"
GOTO END
SET INP(3)="Yy"[X
L7 IF $DATA(^DIC(9.8,0))
DO ANS("Save parameters in ROUTINE file? NO//","NY","Update the ROUTINE file with details")
if X="^"
GOTO END
SET INP(7)="Yy"[X
+1 DO ANS("Index all called routines? NO//","NY","Add called routines")
if X="^"
GOTO END
SET INP(8)="Yy"[X
DEVICE if NRO>2
WRITE !!,$CHAR(7),"This report could take some time, Remember to QUEUE the report.",!
KILL IOP,%ZIS
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
KILL %ZIS
IF POP
WRITE !,*7,"%INDEX terminated. No device specified."
GOTO END
+1 ;S IOP=ION_";"_IOST_$S($D(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
+2 IF IO=IO(0)
IF "C"[$EXTRACT(IOST)
IF $DATA(IO("Q"))#2
WRITE !,"Do you really mean queue to this device? NO//"
DO NY
IF "Nn"[X
WRITE !!,"Ok, tell me again ..."
KILL IO("Q")
DO ^%ZISC
GOTO DEVICE
+3 ;I IO'=IO(0),'$D(IO("Q")) W !!,"I am QUEUEING this report for you." S IO("Q")=1
+4 IF '$DATA(IO("Q"))
GOTO ALIVE^%INDEX
+5 SET ZTRTN="ALIVE^%INDEX"
SET ZTDESC="%INDEX of "_NRO_" routine"_$SELECT(NRO>1:"s.",1:".")
FOR G="INP(","INDDA","^UTILITY($J,","NRO","INDPM"
SET ZTSAVE(G)=""
+6 KILL IO("Q")
DO ^%ZTLOAD
DO HOME^%ZIS
END KILL ZTSK,%ZIS
GOTO CLEAN^%INDX5
ANS(PR,DEF,HELP) ;Ask question get answer
+1 NEW %
FOR
SET Y=1
WRITE !!,PR
DO @DEF
if Y
QUIT
+2 QUIT
YN SET %="Y"
DO RD
if "^YyNn"[X
QUIT
if $DATA(HELP)
WRITE !,HELP
WRITE !,"Please enter 'Y' or return for YES, 'N' for NO"
SET Y=0
QUIT
NY SET %="N"
DO RD
if "^YyNn"[X
QUIT
if $DATA(HELP)
WRITE !,HELP
WRITE !,"Please enter 'N' or return for NO, 'Y' for YES"
SET Y=0
QUIT
RD READ X:DTIME
if X["^"
SET X="^"
SET X=$EXTRACT(X_%)
QUIT
RLIST SET %="R"
DO RD
if "^RSBF"[X
QUIT
WRITE !,"Please select one of the choices."
SET Y=0
QUIT
+1 QUIT
ASKRTN ;Collect a list of routines to index.
+1 IF $DATA(^%ZOSF("RSEL"))
XECUTE ^("RSEL")
SET NRO=0
SET X=0
FOR I=0:0
SET X=$ORDER(^UTILITY($JOB,X))
if X=""
QUIT
SET NRO=NRO+1
+2 QUIT
+3 WRITE !!,"LIST OF ROUTINES TO BE INDEXED; PRESS RETURN TO TERMINATE LIST",!
SET NRO=0
R1 READ !,"ROUTINE NAME: ",ROU:$SELECT($GET(DTIME):DTIME,1:360)
if ROU=""
QUIT
+1 IF ROU'?1"%".UN&(ROU'?1U.UN)
WRITE " INVALID ROUTINE NAME"
GOTO R1
+2 IF $DATA(^%ZOSF("TEST"))
SET X=ROU
XECUTE ^("TEST")
IF '$TEST
WRITE " INVALID ROUTINE NAME"
GOTO R1
+3 SET NRO=NRO+1
SET ^UTILITY($JOB,ROU)=""
GOTO R1
SETUP ;Write startup header stuff.
+1 USE IO
DO HDR
+2 SET Q=""""
SET U="^"
SET INDDS=0
SET RTN="$"
SET DA=INDDA
SET IND("TM")=$HOROLOG
IF INDDA>0
DO START^%INDX10
if IOSL\2<$Y
DO HDR
WRITE !!,"Routines are being processed.",!
+3 WRITE "Indexed Routines: ",NRO,!!
+4 QUIT
HDR DO NOW^%DTC
SET Y=%
SET DT=$PIECE(Y,".",1)
DO DD^%DT
SET INDXDT=Y
XECUTE ^%ZOSF("UCI")
SET INDHDR(1)="UCI: "_$PIECE(Y,",")_" CPU: "_^%ZOSF("VOL")_" "_INDXDT
SET INDHDR="V. A. C R O S S R E F E R E N C E R "_$PIECE($TEXT(+2),";",3)
+1 if $Y>3
WRITE @IOF
WRITE !!,?IOM-$LENGTH(INDHDR)\2,INDHDR,!,?IOM-$LENGTH(INDHDR(1))\2,INDHDR(1),!
+2 QUIT
