%INDX11 ;ISC/GRK - Create phantom routines for functions, options, etc. ;2/19/92 16:30 ;
;;7.3;TOOLKIT;;Apr 25, 1995
W !,"The option and function files are being processed.",!
D NAMSP S INDFN="^DD(""FUNC"",",INDRN="|func",INDD="Function",INDSB="FUNC" D NAME S INDFN="^DIC(19,",INDRN="|opt",INDD="Option",INDSB="OPT" D NAME
Q
NAMSP S INDXN=$P(^DIC(9.4,DA,0),"^",2),C9=0,INDXN(C9)="," F A=0:0 S A=$O(^DIC(9.4,DA,"EX",A)) Q:A'>0 I $D(^(A,0))#2 S C9=C9+1,INDXN(C9)=$P(^(0),"^")
S INDF="S C8=1 F H=1:1:C9 I $P(INDL,INDXN(H))="""" S C8=0 Q" ; Checks excluded namespaces
Q
NAME Q:'$D(@(INDFN_"""B"")")) S INDLC=0,INDC=INDRN_" ; '"_INDXN_"' "_INDD_"s.",INDX=";" D ADD S ^UTILITY($J,INDRN)=""
S INDL=$E(INDXN,1,$L(INDXN)-1)_$C($A(INDXN,$L(INDXN))-1)_"z"
F A=0:0 S INDL=$O(@(INDFN_"""B"",INDL)")) Q:$P(INDL,INDXN,1)]""!(INDL="") F B=0:0 S B=$O(@(INDFN_"""B"",INDL,B)")) Q:B="" X INDF D:C8 @INDSB
I INDLC=2 K ^UTILITY($J,INDRN),^UTILITY($J,1,INDRN) Q
S ^UTILITY($J,1,INDRN,0,0)=INDLC,NRO=NRO+1 Q
FUNC ;Process Function file by namespace
Q:'($D(^DD("FUNC",B,0))#2) S INDC=B_" ; "_$P(^(0),"^",1)_" - "_$S($D(^(9))#2:$E(^(9),1,190),1:""),INDX=$S($D(^(1))#2:^(1),1:";") D ADD
Q
OPT ;Process option file for MUMPS code
Q:'$D(^DIC(19,B,0)) S T=$P(^(0),"^",4),INDC=B_" ; "_$P(^(0),"^",1)_" - "_$P(^(0),"^",2)_" ("_$P($P($P(^DD(19,4,0),"^",3),T_":",2),";",1)_")"_$S($P(^DIC(19,B,0),"^",6)]"":" - Locked by "_$P(^(0),"^",6),1:""),INDX="" D ADD
S INDN="15,20,26,"_$S(T="E":"34,35,54",T="I":"34,35",T="P":"69,69.1,69.2,69.3,71,72,73",T="R":25,1:"") D OPTC:INDN
Q
OPTC F J=1:1 S H=$P(INDN,",",J) Q:H="" I $D(^DIC(19,B,H))#2 D
. S %=^(H),INDX=$S(H'=25:%,1:"D "_$E("^",%'["^")_$P(%,"[")),INDC=" ; "_$P(^DD(19,H,0),"^",1) D ADD
Q
ADD ;Put code in UTILITY for processing
S INDLC=INDLC+1,^UTILITY($J,1,INDRN,0,INDLC,0)=INDC I INDX]"" S INDLC=INDLC+1,^UTILITY($J,1,INDRN,0,INDLC,0)=" "_INDX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZINDX11 1917 printed Dec 13, 2024@02:42:32 Page 2
%INDX11 ;ISC/GRK - Create phantom routines for functions, options, etc. ;2/19/92 16:30 ;
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 WRITE !,"The option and function files are being processed.",!
+3 DO NAMSP
SET INDFN="^DD(""FUNC"","
SET INDRN="|func"
SET INDD="Function"
SET INDSB="FUNC"
DO NAME
SET INDFN="^DIC(19,"
SET INDRN="|opt"
SET INDD="Option"
SET INDSB="OPT"
DO NAME
+4 QUIT
NAMSP SET INDXN=$PIECE(^DIC(9.4,DA,0),"^",2)
SET C9=0
SET INDXN(C9)=","
FOR A=0:0
SET A=$ORDER(^DIC(9.4,DA,"EX",A))
if A'>0
QUIT
IF $DATA(^(A,0))#2
SET C9=C9+1
SET INDXN(C9)=$PIECE(^(0),"^")
+1 ; Checks excluded namespaces
SET INDF="S C8=1 F H=1:1:C9 I $P(INDL,INDXN(H))="""" S C8=0 Q"
+2 QUIT
NAME if '$DATA(@(INDFN_"""B"")"))
QUIT
SET INDLC=0
SET INDC=INDRN_" ; '"_INDXN_"' "_INDD_"s."
SET INDX=";"
DO ADD
SET ^UTILITY($JOB,INDRN)=""
+1 SET INDL=$EXTRACT(INDXN,1,$LENGTH(INDXN)-1)_$CHAR($ASCII(INDXN,$LENGTH(INDXN))-1)_"z"
+2 FOR A=0:0
SET INDL=$ORDER(@(INDFN_"""B"",INDL)"))
if $PIECE(INDL,INDXN,1)]""!(INDL="")
QUIT
FOR B=0:0
SET B=$ORDER(@(INDFN_"""B"",INDL,B)"))
if B=""
QUIT
XECUTE INDF
if C8
DO @INDSB
+3 IF INDLC=2
KILL ^UTILITY($JOB,INDRN),^UTILITY($JOB,1,INDRN)
QUIT
+4 SET ^UTILITY($JOB,1,INDRN,0,0)=INDLC
SET NRO=NRO+1
QUIT
FUNC ;Process Function file by namespace
+1 if '($DATA(^DD("FUNC",B,0))#2)
QUIT
SET INDC=B_" ; "_$PIECE(^(0),"^",1)_" - "_$SELECT($DATA(^(9))#2:$EXTRACT(^(9),1,190),1:"")
SET INDX=$SELECT($DATA(^(1))#2:^(1),1:";")
DO ADD
+2 QUIT
OPT ;Process option file for MUMPS code
+1 if '$DATA(^DIC(19,B,0))
QUIT
SET T=$PIECE(^(0),"^",4)
SET INDC=B_" ; "_$PIECE(^(0),"^",1)_" - "_$PIECE(^(0),"^",2)_" ("_$PIECE($PIECE($PIECE(^DD(19,4,0),"^",3),T_":",2),";",1)_")"_$SELECT($PIECE(^DIC(19,B,0),"^",6)]"":" - Locked by "_$PIECE(^(0),"^",6),1:"")
SET INDX=""
DO ADD
+2 SET INDN="15,20,26,"_$SELECT(T="E":"34,35,54",T="I":"34,35",T="P":"69,69.1,69.2,69.3,71,72,73",T="R":25,1:"")
if INDN
DO OPTC
+3 QUIT
OPTC FOR J=1:1
SET H=$PIECE(INDN,",",J)
if H=""
QUIT
IF $DATA(^DIC(19,B,H))#2
Begin DoDot:1
+1 SET %=^(H)
SET INDX=$SELECT(H'=25:%,1:"D "_$EXTRACT("^",%'["^")_$PIECE(%,"["))
SET INDC=" ; "_$PIECE(^DD(19,H,0),"^",1)
DO ADD
End DoDot:1
+2 QUIT
ADD ;Put code in UTILITY for processing
+1 SET INDLC=INDLC+1
SET ^UTILITY($JOB,1,INDRN,0,INDLC,0)=INDC
IF INDX]""
SET INDLC=INDLC+1
SET ^UTILITY($JOB,1,INDRN,0,INDLC,0)=" "_INDX
+2 QUIT
