- XINDX6 ;ISC/REL,GRK - GET SET OF ROUTINES TO INDEX ;07/22/08 13:54
- ;;7.3;TOOLKIT;**20,27,66,110,132,140**;Apr 25, 1995;Build 40
- ; Per VHA Directive 2004-038, this routine should not be modified.
- ;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, 10 = Build or Package file DA
- ;INP(11= execute to check for version number on second line, 12= Patch number check.
- N %A2,%I,%IN2,%IN3,%N,%QMK,%YN,AC,ANS,C8,CM,CX,DEF,DDOT,DIF,E,EC,ER
- N INDHDR,INP,LI,LL,LN,LV,N,NOA,OP,PG,QUES,RN,T,XCNP,XX1,XX2,Z,Z1,INDXDT
- K ^UTILITY($J),ZTSK,ZTDTH,ZTIO
- S:'$D(DTIME)#2 DTIME=360
- D HOME^%ZIS,HDR^XINDX7
- D ASKRTN,PARAM
- I $D(^DIC(9.4))!$D(^DIC(9.6)) D ^XINDX10 G END:$D(DUOUT) S INDDA=DA I DA>0,INP(10)'=9.7 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 or Control (F)low ? R//","RLIST") G:X="^" END S INP(5)=X
- I INDDA>0,INP(10)'=9.7 D ANS("Print the DDs, Functions, Options, and other package code? 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(DUZ) 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 !,$C(7),"XINDEX 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 '$D(IO("Q")) G ALIVE^XINDEX ;Do it now
- ;Queue Report
- S ZTRTN="ALIVE^XINDEX",ZTDESC="XINDEX 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^XINDX5
- ;
- PARAM ;Setup Parameters
- S Q="""",RTN=0
- F I=1:1:10 S INP(I)=0
- S (INP(11),INP(12))=""
- S INP("MAX")=20000 ;Max routine size
- S INP("CMAX")=15000 ;Max Code in routine
- S INDDA=0
- Q
- ;
- QUICK(RL) ;Quick Report, Just errors on some routines.
- N %A2,%I,%IN2,%IN3,%N,%QMK,%YN,AC,ANS,C8,CM,CX,DEF,DDOT,DIF,E,EC,ER
- N INDHDR,INDXDT,INP,LI,LL,LN,LV,N,NOA,OP,PG,QUES,RN,T,XCNP,XX1,XX2,Z,Z1
- K ^UTILITY($J),ZTSK,ZTDTH,ZTIO
- D HOME^%ZIS I '$D(IOP) D HDR^XINDX7
- I $D(IOP) S %ZIS="" D ^%ZIS ;Caller can set IOP to send output someplace else
- U IO
- I $D(RL) F %I=1:1 S Z=$P(RL,",",%I) Q:Z="" S ^UTILITY($J,Z)=""
- D ASKRTN,PARAM
- I $O(^UTILITY($J,"@"))="" W !,"No Routines to process.",! D ^%ZISC Q
- S INP(1)=0,INP(6)=1 ;More then errors,Summary Only
- G ALIVE^XINDEX
- ;
- 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($$CASE^XINDX52(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(^UTILITY($J)),$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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXINDX6 4556 printed Feb 19, 2025@00:06:35 Page 2
- XINDX6 ;ISC/REL,GRK - GET SET OF ROUTINES TO INDEX ;2018-02-22 2:44 PM
- +1 ;;7.3;TOOLKIT;**20,27,66,110,132,10001**;Apr 25, 1995;Build 4
- +2 ; Original routine authored by U.S. Department of Veterans Affairs
- +3 ; XINDX6+14,+20 modified by Christopher Edwards 2018
- +4 ; XINDX6+13,RLIST Modified by David Whitten (year unknown)
- +5 ;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
- +6 ;INP(8= Index called routines, 9= Include the Compiled template routines, 10 = Build or Package file DA
- +7 ;INP(11= execute to check for version number on second line, 12= Patch number check.
- +8 NEW %A2,%I,%IN2,%IN3,%N,%QMK,%YN,AC,ANS,C8,CM,CX,DEF,DDOT,DIF,E,EC,ER
- +9 NEW INDHDR,INP,LI,LL,LN,LV,N,NOA,OP,PG,QUES,RN,T,XCNP,XX1,XX2,Z,Z1,INDXDT
- +10 KILL ^UTILITY($JOB),ZTSK,ZTDTH,ZTIO
- +11 if '$DATA(DTIME)#2
- SET DTIME=360
- +12 DO HOME^%ZIS
- DO HDR^XINDX7
- +13 DO ASKRTN
- DO PARAM
- +14 IF $DATA(^DIC(9.4))!$DATA(^DIC(9.6))
- DO ^XINDX10
- if $DATA(DUOUT)
- GOTO END
- SET INDDA=DA
- IF DA>0
- IF (INP(10)'=9.7)!(INP(10)="NAMESPACE")
- DO ANS("Include the compiled template routines: N//","NY")
- if X="^"
- GOTO END
- if "Nn"'[X
- SET INP(9)=1
- +15 if (NRO'>0)&(INDDA'>0)
- GOTO END
- +16 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
- +17 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
- +18 DO ANS("Print routines? YES//","YN","Print routines code also")
- if X="^"
- GOTO END
- SET INP(2)="Yy"[X
- +19 IF INP(2)
- DO ANS("Print (R)egular,(S)tructured or (B)oth or Control (F)low ? R//","RLIST")
- if X="^"
- GOTO END
- SET INP(5)=X
- +20 IF INDDA>0
- IF INP(10)'=9.7
- DO ANS("Print the DDs, Functions, Options, and other package code? YES//","YN","Gather other package code.")
- if X="^"
- GOTO END
- SET INP(4)="Yy"[X
- +21 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))
- IF $DATA(DUZ)
- 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 !,$CHAR(7),"XINDEX 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 ;Do it now
- IF '$DATA(IO("Q"))
- GOTO ALIVE^XINDEX
- +4 ;Queue Report
- +5 SET ZTRTN="ALIVE^XINDEX"
- SET ZTDESC="XINDEX 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
- +7 ;
- END KILL ZTSK,%ZIS
- GOTO CLEAN^XINDX5
- +1 ;
- PARAM ;Setup Parameters
- +1 SET Q=""""
- SET RTN=0
- +2 FOR I=1:1:10
- SET INP(I)=0
- +3 SET (INP(11),INP(12))=""
- +4 ;Max routine size
- SET INP("MAX")=20000
- +5 ;Max Code in routine
- SET INP("CMAX")=15000
- +6 SET INDDA=0
- +7 QUIT
- +8 ;
- QUICK(RL) ;Quick Report, Just errors on some routines.
- +1 NEW %A2,%I,%IN2,%IN3,%N,%QMK,%YN,AC,ANS,C8,CM,CX,DEF,DDOT,DIF,E,EC,ER
- +2 NEW INDHDR,INDXDT,INP,LI,LL,LN,LV,N,NOA,OP,PG,QUES,RN,T,XCNP,XX1,XX2,Z,Z1
- +3 KILL ^UTILITY($JOB),ZTSK,ZTDTH,ZTIO
- +4 DO HOME^%ZIS
- IF '$DATA(IOP)
- DO HDR^XINDX7
- +5 ;Caller can set IOP to send output someplace else
- IF $DATA(IOP)
- SET %ZIS=""
- DO ^%ZIS
- +6 USE IO
- +7 IF $DATA(RL)
- FOR %I=1:1
- SET Z=$PIECE(RL,",",%I)
- if Z=""
- QUIT
- SET ^UTILITY($JOB,Z)=""
- +8 DO ASKRTN
- DO PARAM
- +9 IF $ORDER(^UTILITY($JOB,"@"))=""
- WRITE !,"No Routines to process.",!
- DO ^%ZISC
- QUIT
- +10 ;More then errors,Summary Only
- SET INP(1)=0
- SET INP(6)=1
- +11 GOTO ALIVE^XINDEX
- +12 ;
- 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
- +1 ;
- 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
- +1 ;
- RD READ X:DTIME
- if X["^"
- SET X="^"
- SET X=$EXTRACT($$CASE^XINDX52(X)_%)
- QUIT
- +1 ;
- 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(^UTILITY($JOB))
- IF $DATA(^%ZOSF("RSEL"))
- XECUTE ^("RSEL")
- +2 SET NRO=0
- SET X=0
- FOR I=0:0
- SET X=$ORDER(^UTILITY($JOB,X))
- if X=""
- QUIT
- SET NRO=NRO+1
- +3 QUIT
- +4 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)=""
- +4 GOTO R1
