- XINDX11 ;ISC/GRK - Create phantom routines for functions, options, etc. ;07/08/98 15:06
- ;;7.3;TOOLKIT;**20,27,121,132**;Apr 25, 1995;Build 14
- ; Per VHA Directive 2004-038, this routine should not be modified.
- G:INP(10)=9.7 RTN
- W !,"The option and function files are being processed.",!
- G:INP(10)=9.4 PKG
- N KRN,TYPE ;Build file
- S INDFN="^DD(""FUNC"",",INDRN="|func",INDD="Function",INDSB="FUNC",INDXN="Build file" D HDR
- F KRN=0:0 S KRN=$O(^XPD(9.6,INDDA,"KRN",.5,"NM",KRN)) Q:KRN'>0 S INDXN=$P(^(KRN,0),U) D ENTRY
- I INDLC=2 K ^UTILITY($J,INDRN),^UTILITY($J,1,INDRN) ;patch 121
- S INDFN="^DIC(19,",INDRN="|opt",INDD="Option",INDSB="OPT",INDXN="Build file" D HDR
- F KRN=0:0 S KRN=$O(^XPD(9.6,INDDA,"KRN",19,"NM",KRN)) Q:KRN'>0 S INDXN=$P(^(KRN,0),U) D ENTRY
- I INDLC=2 K ^UTILITY($J,INDRN),^UTILITY($J,1,INDRN)
- RTN ;Routines
- ;F KRN=0:0 S KRN=$O(^XPD(9.6,INDDA,"KRN",9.8,"NM",KRN)) Q:KRN'>0 S X=^(KRN,0) I '$P(X,U,3) S ^UTILITY($J,$P(X,U))=""
- I $T(RTN^XTRUTL1)]"" D RTN^XTRUTL1(INDDA,INP(10))
- Q
- PKG D NAMSP ;Package file
- 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
- NAME Q:'$D(@(INDFN_"""B"")"))
- D HDR
- 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
- 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
- HDR S INDLC=0,INDC=INDRN_" ; '"_INDXN_"' "_INDD_"s.",INDX=";" D ADD S ^UTILITY($J,INDRN)="",^UTILITY($J,1,INDRN,0,0)=0
- Q
- ENTRY F B=0:0 S B=$O(@(INDFN_"""B"",INDXN,B)")) Q:B="" D @INDSB
- ;I INDLC=2 K ^UTILITY($J,INDRN),^UTILITY($J,1,INDRN) Q ;patch 121 moved to top of routine
- S ^UTILITY($J,1,INDRN,0,0)=INDLC
- Q
- FUNC ;Process Function file entry
- 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 entry 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
- XINDX11 ;ISC/GRK - Create phantom routines for functions, options, etc. ;07/08/98 15:06
- +1 ;;7.3;TOOLKIT;**20,27,121,132**;Apr 25, 1995;Build 14
- +2 ; Per VHA Directive 2004-038, this routine should not be modified.
- +3 IF INP(10)=9.7
- GOTO RTN
- +4 WRITE !,"The option and function files are being processed.",!
- +5 IF INP(10)=9.4
- GOTO PKG
- +6 ;Build file
- NEW KRN,TYPE
- +7 SET INDFN="^DD(""FUNC"","
- SET INDRN="|func"
- SET INDD="Function"
- SET INDSB="FUNC"
- SET INDXN="Build file"
- DO HDR
- +8 FOR KRN=0:0
- SET KRN=$ORDER(^XPD(9.6,INDDA,"KRN",.5,"NM",KRN))
- IF KRN'>0
- QUIT
- SET INDXN=$PIECE(^(KRN,0),U)
- DO ENTRY
- +9 ;patch 121
- IF INDLC=2
- KILL ^UTILITY($JOB,INDRN),^UTILITY($JOB,1,INDRN)
- +10 SET INDFN="^DIC(19,"
- SET INDRN="|opt"
- SET INDD="Option"
- SET INDSB="OPT"
- SET INDXN="Build file"
- DO HDR
- +11 FOR KRN=0:0
- SET KRN=$ORDER(^XPD(9.6,INDDA,"KRN",19,"NM",KRN))
- IF KRN'>0
- QUIT
- SET INDXN=$PIECE(^(KRN,0),U)
- DO ENTRY
- +12 IF INDLC=2
- KILL ^UTILITY($JOB,INDRN),^UTILITY($JOB,1,INDRN)
- RTN ;Routines
- +1 ;F KRN=0:0 S KRN=$O(^XPD(9.6,INDDA,"KRN",9.8,"NM",KRN)) Q:KRN'>0 S X=^(KRN,0) I '$P(X,U,3) S ^UTILITY($J,$P(X,U))=""
- +2 IF $TEXT(RTN^XTRUTL1)]""
- DO RTN^XTRUTL1(INDDA,INP(10))
- +3 QUIT
- PKG ;Package file
- DO NAMSP
- +1 SET INDFN="^DD(""FUNC"","
- SET INDRN="|func"
- SET INDD="Function"
- SET INDSB="FUNC"
- DO NAME
- +2 SET INDFN="^DIC(19,"
- SET INDRN="|opt"
- SET INDD="Option"
- SET INDSB="OPT"
- DO NAME
- +3 QUIT
- NAME IF '$DATA(@(INDFN_"""B"")"))
- QUIT
- +1 DO HDR
- +2 SET INDL=$EXTRACT(INDXN,1,$LENGTH(INDXN)-1)_$CHAR($ASCII(INDXN,$LENGTH(INDXN))-1)_"z"
- +3 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
- +4 IF INDLC=2
- KILL ^UTILITY($JOB,INDRN),^UTILITY($JOB,1,INDRN)
- QUIT
- +5 SET ^UTILITY($JOB,1,INDRN,0,0)=INDLC
- +6 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
- HDR SET INDLC=0
- SET INDC=INDRN_" ; '"_INDXN_"' "_INDD_"s."
- SET INDX=";"
- DO ADD
- SET ^UTILITY($JOB,INDRN)=""
- SET ^UTILITY($JOB,1,INDRN,0,0)=0
- +1 QUIT
- ENTRY FOR B=0:0
- SET B=$ORDER(@(INDFN_"""B"",INDXN,B)"))
- IF B=""
- QUIT
- DO @INDSB
- +1 ;I INDLC=2 K ^UTILITY($J,INDRN),^UTILITY($J,1,INDRN) Q ;patch 121 moved to top of routine
- +2 SET ^UTILITY($JOB,1,INDRN,0,0)=INDLC
- +3 QUIT
- FUNC ;Process Function file entry
- +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 entry 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
