- XINDX11 ;ISC/GRK - Create phantom routines for functions, options, etc. ;07/08/98 15:06
- ;;7.3;TOOLKIT;**20,27,121,132,140,148**;Apr 25, 1995;Build 3
- ; Per VHA Directive 2004-038, this routine should not be modified.
- G:INP(10)=9.7 RTN
- N INDSTAT ;p148 tracks if status message was displayed
- G:INP(10)=9.4 PKG
- BUILD ; Process Build File
- N KRN,BLDFIL,BLDDEL
- S BLDDEL=U
- S BLDFIL=.5,INDFN="^DD(""FUNC"",",INDRN="|func",INDD="Function",INDSB="FUNC",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=19,INDFN="^DIC(19,",INDRN="|opt",INDD="Option",INDSB="OPT",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDDEL=" "
- S BLDFIL=.401,INDFN="^DIBT(",INDRN="|sort",INDD="Sort Template",INDSB="SORT^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=.402,INDFN="^DIE(",INDRN="|inpt",INDD="Input Template",INDSB="INPUT^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=.4,INDFN="^DIPT(",INDRN="|prnt",INDD="Print Template",INDSB="PRINT^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=.403,INDFN="^DIST(.403,",INDRN="|form",INDD="Form",INDSB="FORM^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDDEL=U
- S BLDFIL=.84,INDFN="^DI(.84,",INDRN="|dlg",INDD="Dialog",INDSB="DIALOG^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=9.2,INDFN="^DIC(9.2,",INDRN="|help",INDD="Help Frame",INDSB="HELP^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=19.1,INDFN="^DIC(19.1,",INDRN="|key",INDD="Security Key",INDSB="KEY^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=409.61,INDFN="^SD(409.61,",INDRN="|list",INDD="List Template",INDSB="LIST^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=101,INDFN="^ORD(101,",INDRN="|ptcl",INDD="Protocol",INDSB="PROTOCOL^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=771,INDFN="^HL(771,",INDRN="|hlap",INDD="HL7 Application Parameter",INDSB="HL7AP^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- S BLDFIL=8994,INDFN="^XWB(8994,",INDRN="|rpc",INDD="Remote Procedure",INDSB="RPC^XINDX12",INDXN="Build file",INDSTAT=0 D BLDITEM
- RTN ;Routines
- D RTN^XTRUTL1(INDDA,INP(10))
- Q
- ;
- BLDITEM ; Process Each Build item in build file
- D HDR
- F KRN=0:0 S KRN=$O(^XPD(9.6,INDDA,"KRN",BLDFIL,"NM",KRN)) Q:KRN'>0 S (INDL,INDXN)=$P(^(KRN,0),BLDDEL) D STAT:'INDSTAT,ENTRY
- I INDLC=2 K ^UTILITY($J,INDRN),^UTILITY($J,1,INDRN) ;patch 121
- QUIT
- ;
- PKG D NAMSP ;Package file
- S INDFN="^DD(""FUNC"",",INDRN="|func",INDD="Function",INDSB="FUNC",INDSTAT=0 D NAME
- S INDFN="^DIC(19,",INDRN="|opt",INDD="Option",INDSB="OPT",INDSTAT=0 D NAME
- S INDFN="^DIBT(",INDRN="|sort",INDD="Sort Template",INDSB="SORT^XINDX12",INDSTAT=0 D NAME
- S INDFN="^DIE(",INDRN="|inpt",INDD="Input Template",INDSB="INPUT^XINDX12",INDSTAT=0 D NAME
- S INDFN="^DIPT(",INDRN="|prnt",INDD="Print Template",INDSB="PRINT^XINDX12",INDSTAT=0 D NAME
- S INDFN="^DIST(.403,",INDRN="|form",INDD="Form",INDSB="FORM^XINDX12",INDSTAT=0 D NAME
- S INDFN="^DI(.84,",INDRN="|dlg",INDD="Dialog",INDSB="DIALOG^XINDX12",INDSTAT=0 D NAME
- S INDFN="^DIC(9.2,",INDRN="|help",INDD="Help Frame",INDSB="HELP^XINDX12",INDSTAT=0 D NAME
- S INDFN="^DIC(19.1,",INDRN="|key",INDD="Security Key",INDSB="KEY^XINDX12",INDSTAT=0 D NAME
- S INDFN="^SD(409.61,",INDRN="|list",INDD="List Template",INDSB="LIST^XINDX12",INDSTAT=0 D NAME
- S INDFN="^ORD(101,",INDRN="|ptcl",INDD="Protocol",INDSB="PROTOCOL^XINDX12",INDSTAT=0 D NAME
- S INDFN="^HL(771,",INDRN="|hlap",INDD="HL7 Application Parameter",INDSB="HL7AP^XINDX12",INDSTAT=0 D NAME
- S INDFN="^XWB(8994,",INDRN="|rpc",INDD="Remote Procedure",INDSB="RPC^XINDX12",INDSTAT=0 D NAME
- Q
- ;
- NAME ; Index based on Package file #9.4
- Q:'$D(@(INDFN_"""B"")")) ; Don't run if there isn't a B cross reference
- D HDR ; Add Header in the style of |{component} ; '{Namespace}' {Filename as defined above}s. With a comment line below.
- S INDL=$E(INDXN,1,$L(INDXN)-1)_$C($A(INDXN,$L(INDXN))-1)_"z" ; get the last letter of the prefix and get the previous letter (B=A), then append "z" to the end
- F A=0:0 S INDL=$O(@(INDFN_"""B"",INDL)")) Q:$P(INDL,INDXN,1)]""!(INDL="") D ; Order through the B index of the given file. If it nolonger matches the prefix or we hit the end of the B index quit
- . F B=0:0 S B=$O(@(INDFN_"""B"",INDL,B)")) Q:B="" D ; For each IEN in the B index
- .. X INDF ; Make sure it isn't an excluded namespace
- .. D:C8 STAT:'INDSTAT,@INDSB ; If it isn't an excluded namesapce cross reference it
- I INDLC=2 K ^UTILITY($J,INDRN),^UTILITY($J,1,INDRN) Q ; If there is only a header delete the faux routine
- S ^UTILITY($J,1,INDRN,0,0)=INDLC ; set the number of lines in the routine where the output will find it
- Q
- NAMSP ; Setup processing for Indexing based on package file
- S INDXN=$P(^DIC(9.4,DA,0),"^",2) ; PREFIX (#1) from Package File
- S C9=0 ; Subscript for INDXN
- S INDXN(C9)="," ; 0th subscript is always ","
- F A=0:0 S A=$O(^DIC(9.4,DA,"EX",A)) Q:A'>0 D ; For each excluded name space in the package file
- . I $D(^(A,0))#2 D ; If there is an excluded namespace value
- .. S C9=C9+1 ; increment the counter
- .. S INDXN(C9)=$P(^(0),"^") ; set INDXN(COUNTER)=excluded namespace
- S INDF="S C8=1 F H=1:1:C9 I $P(INDL,INDXN(H))="""" S C8=0 Q" ; Checks excluded namespaces
- Q
- STAT ;write status ;p148
- S INDSTAT=1
- W !,"Processing ",INDD,"s",!
- 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
- 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
- ADDLN ;
- S INDLC=INDLC+1,^UTILITY($J,1,INDRN,0,INDLC,0)=" "_INDX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXINDX11 9235 printed Jan 18, 2025@03:41:05 Page 2
- XINDX11 ;ISC/GRK - Create phantom routines for functions, options, etc. ;2018-03-01 8:33 AM
- +1 ;;7.3;TOOLKIT;**20,27,121,132,10001**;Apr 25, 1995;Build 4
- +2 ; Original routine authored by U.S. Department of Veterans Affairs
- +3 ; Entrypoints PKG+3ff,LNS,NS,NAME,NAMSP,ADDLN &
- +4 ; Line XINDX11+8 added by Christopher Edwards
- +5 ; BUILD,BLDITEM entry point by Sam Habiel
- +6 if INP(10)=9.77
- GOTO RTN
- +7 WRITE !,"The option and function files are being processed.",!
- +8 if INP(10)=9.4
- GOTO PKG
- +9 if INP(10)="NAMESPACE"
- GOTO LNS
- +10 ;
- BUILD ; Process Build File. Fall through from above.
- +1 ; ZEXCEPT: INDFN,INDRN,INDD,INDSB,INDXN
- +2 ; build file ien,Build file,Entry Delimiter
- +3 NEW KRN,BLDFIL,BLDDEL
- +4 ;
- +5 SET BLDDEL=U
- +6 SET BLDFIL=.5
- SET INDFN="^DD(""FUNC"","
- SET INDRN="|func"
- SET INDD="Function"
- SET INDSB="FUNC"
- SET INDXN="Build file"
- DO BLDITEM
- +7 SET BLDFIL=19
- SET INDFN="^DIC(19,"
- SET INDRN="|opt"
- SET INDD="Option"
- SET INDSB="OPT"
- SET INDXN="Build file"
- DO BLDITEM
- +8 ;
- +9 ; OSE/SMH - New with *10001*
- +10 SET BLDDEL=" "
- +11 SET BLDFIL=.401
- SET INDFN="^DIBT("
- SET INDRN="|sort"
- SET INDD="Sort Template"
- SET INDSB="SORT^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +12 SET BLDFIL=.402
- SET INDFN="^DIE("
- SET INDRN="|inpt"
- SET INDD="Input Template"
- SET INDSB="INPUT^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +13 SET BLDFIL=.4
- SET INDFN="^DIPT("
- SET INDRN="|prnt"
- SET INDD="Print Template"
- SET INDSB="PRINT^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +14 SET BLDFIL=.403
- SET INDFN="^DIST(.403,"
- SET INDRN="|form"
- SET INDD="Form"
- SET INDSB="FORM^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +15 SET BLDDEL=U
- +16 SET BLDFIL=.84
- SET INDFN="^DI(.84,"
- SET INDRN="|dlg"
- SET INDD="Dialog"
- SET INDSB="DIALOG^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +17 SET BLDFIL=9.2
- SET INDFN="^DIC(9.2,"
- SET INDRN="|help"
- SET INDD="Help Frame"
- SET INDSB="HELP^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +18 SET BLDFIL=19.1
- SET INDFN="^DIC(19.1,"
- SET INDRN="|key"
- SET INDD="Security Key"
- SET INDSB="KEY^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +19 SET BLDFIL=409.61
- SET INDFN="^SD(409.61,"
- SET INDRN="|list"
- SET INDD="List Template"
- SET INDSB="LIST^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +20 SET BLDFIL=101
- SET INDFN="^ORD(101,"
- SET INDRN="|ptcl"
- SET INDD="Protocol"
- SET INDSB="PROTOCOL^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +21 SET BLDFIL=771
- SET INDFN="^HL(771,"
- SET INDRN="|hlap"
- SET INDD="HL7 Application Parameter"
- SET INDSB="HL7AP^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +22 SET BLDFIL=8994
- SET INDFN="^XWB(8994,"
- SET INDRN="|rpc"
- SET INDD="Remote Procedure"
- SET INDSB="RPC^XINDX12"
- SET INDXN="Build file"
- DO BLDITEM
- +23 ; /New with *10001*
- +24 ;
- RTN ;Routines (fallthrough)
- +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
- +4 ;
- +5 ; New with *10001*
- BLDITEM ; [Private] Process Each Build item in build file
- +1 DO HDR
- +2 FOR KRN=0:0
- SET KRN=$ORDER(^XPD(9.6,INDDA,"KRN",BLDFIL,"NM",KRN))
- if KRN'>0
- QUIT
- SET (INDL,INDXN)=$PIECE(^(KRN,0),BLDDEL)
- DO ENTRY
- +3 ;patch 121
- IF INDLC=2
- KILL ^UTILITY($JOB,INDRN),^UTILITY($JOB,1,INDRN)
- +4 QUIT
- +5 ; /New with *10001*
- +6 ;
- 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 ; CJE Add more build components that chan have MUMPS Code
- +4 SET INDFN="^DIBT("
- SET INDRN="|sort"
- SET INDD="Sort Template"
- SET INDSB="SORT^XINDX12"
- DO NAME
- +5 SET INDFN="^DIE("
- SET INDRN="|inpt"
- SET INDD="Input Template"
- SET INDSB="INPUT^XINDX12"
- DO NAME
- +6 SET INDFN="^DIPT("
- SET INDRN="|prnt"
- SET INDD="Print Template"
- SET INDSB="PRINT^XINDX12"
- DO NAME
- +7 SET INDFN="^DIST(.403,"
- SET INDRN="|form"
- SET INDD="Form"
- SET INDSB="FORM^XINDX12"
- DO NAME
- +8 SET INDFN="^DI(.84,"
- SET INDRN="|dlg"
- SET INDD="Dialog"
- SET INDSB="DIALOG^XINDX12"
- DO NAME
- +9 SET INDFN="^DIC(9.2,"
- SET INDRN="|help"
- SET INDD="Help Frame"
- SET INDSB="HELP^XINDX12"
- DO NAME
- +10 SET INDFN="^DIC(19.1,"
- SET INDRN="|key"
- SET INDD="Security Key"
- SET INDSB="KEY^XINDX12"
- DO NAME
- +11 SET INDFN="^SD(409.61,"
- SET INDRN="|list"
- SET INDD="List Template"
- SET INDSB="LIST^XINDX12"
- DO NAME
- +12 SET INDFN="^ORD(101,"
- SET INDRN="|ptcl"
- SET INDD="Protocol"
- SET INDSB="PROTOCOL^XINDX12"
- DO NAME
- +13 SET INDFN="^HL(771,"
- SET INDRN="|hlap"
- SET INDD="HL7 Application Parameter"
- SET INDSB="HL7AP^XINDX12"
- DO NAME
- +14 SET INDFN="^XWB(8994,"
- SET INDRN="|rpc"
- SET INDD="Remote Procedure"
- SET INDSB="RPC^XINDX12"
- DO NAME
- +15 QUIT
- LNS ; Defined list of namespaces
- SET INDXN="NAMESPACE"
- +1 SET INDFN="^DD(""FUNC"","
- SET INDRN="|func"
- SET INDD="Function"
- SET INDSB="FUNC"
- DO NS
- +2 SET INDFN="^DIC(19,"
- SET INDRN="|opt"
- SET INDD="Option"
- SET INDSB="OPT"
- DO NS
- +3 SET INDFN="^DIBT("
- SET INDRN="|sort"
- SET INDD="Sort Template"
- SET INDSB="SORT^XINDX12"
- DO NS
- +4 SET INDFN="^DIE("
- SET INDRN="|inpt"
- SET INDD="Input Template"
- SET INDSB="INPUT^XINDX12"
- DO NS
- +5 SET INDFN="^DIPT("
- SET INDRN="|prnt"
- SET INDD="Print Template"
- SET INDSB="PRINT^XINDX12"
- DO NS
- +6 SET INDFN="^DIST(.403,"
- SET INDRN="|form"
- SET INDD="Form"
- SET INDSB="FORM^XINDX12"
- DO NS
- +7 SET INDFN="^DI(.84,"
- SET INDRN="|dlg"
- SET INDD="Dialog"
- SET INDSB="DIALOG^XINDX12"
- DO NS
- +8 SET INDFN="^DIC(9.2,"
- SET INDRN="|help"
- SET INDD="Help Frame"
- SET INDSB="HELP^XINDX12"
- DO NS
- +9 SET INDFN="^DIC(19.1,"
- SET INDRN="|key"
- SET INDD="Security Key"
- SET INDSB="KEY^XINDX12"
- DO NS
- +10 SET INDFN="^SD(409.61,"
- SET INDRN="|list"
- SET INDD="List Template"
- SET INDSB="LIST^XINDX12"
- DO NS
- +11 SET INDFN="^ORD(101,"
- SET INDRN="|ptcl"
- SET INDD="Protocol"
- SET INDSB="PROTOCOL^XINDX12"
- DO NS
- +12 SET INDFN="^HL(771,"
- SET INDRN="|hlap"
- SET INDD="HL7 Application Parameter"
- SET INDSB="HL7AP^XINDX12"
- DO NS
- +13 SET INDFN="^XWB(8994,"
- SET INDRN="|rpc"
- SET INDD="Remote Procedure"
- SET INDSB="RPC^XINDX12"
- DO NS
- +14 KILL NAMESPACES,ENAMESPACES,FILES
- +15 QUIT
- NS ;Index based on a list of namespaces
- +1 ; Don't run if there isn't a B cross reference
- if '$DATA(@(INDFN_"""B"")"))
- QUIT
- +2 ; Add Header in the style of |{component} ; '{Namespace}' {Filename as defined above}s. With a comment line below.
- DO HDR
- +3 NEW EXCLUDE,ISNOTEXCLUDED,PROCESSEDIENS
- +4 FOR
- SET INDXN=$ORDER(NAMESPACES($JOB,INDXN))
- if INDXN=""
- QUIT
- Begin DoDot:1
- +5 ; get the last letter of the prefix(INDXN) and get the previous letter (B=A), then append "z" to the end
- SET INDL=$EXTRACT(INDXN,1,$LENGTH(INDXN)-1)_$CHAR($ASCII(INDXN,$LENGTH(INDXN))-1)_"z"
- +6 ; Order through the B index of the given file. If it nolonger matches the prefix or we hit the end of the B index quit
- FOR A=0:0
- SET INDL=$ORDER(@(INDFN_"""B"",INDL)"))
- if $PIECE(INDL,INDXN,1)]""!(INDL="")
- QUIT
- Begin DoDot:2
- +7 ; For each IEN in the B index
- FOR B=0:0
- SET B=$ORDER(@(INDFN_"""B"",INDL,B)"))
- if B=""
- QUIT
- Begin DoDot:3
- +8 IF $DATA(@(INDFN_"""B"",INDL,B)"))=10
- WRITE !,"SKIPPING SYNONYM "_INDL
- QUIT
- +9 IF $DATA(PROCESSEDIENS(B))
- QUIT
- +10 SET PROCESSEDIENS(B)=""
- +11 SET ISNOTEXCLUDED=1
- SET EXCLUDE=""
- FOR
- SET EXCLUDE=$ORDER(ENAMESPACES($JOB,EXCLUDE))
- if EXCLUDE=""
- QUIT
- IF $PIECE(INDL,$EXTRACT(EXCLUDE,2,$LENGTH(EXCLUDE)))=""
- SET ISNOTEXCLUDED=0
- QUIT
- +12 ; cross reference it
- if ISNOTEXCLUDED
- DO @INDSB
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 ; If there is only a header delete the faux routine
- IF INDLC=2
- KILL ^UTILITY($JOB,INDRN),^UTILITY($JOB,1,INDRN)
- QUIT
- +14 ; set the number of lines in the routine where the output will find it
- SET ^UTILITY($JOB,1,INDRN,0,0)=INDLC
- +15 QUIT
- NAME ; Index based on package file
- +1 ; Don't run if there isn't a B cross reference
- if '$DATA(@(INDFN_"""B"")"))
- QUIT
- +2 ; Add Header in the style of |{component} ; '{Namespace}' {Filename as defined above}s. With a comment line below.
- DO HDR
- +3 ; get the last letter of the prefix and get the previous letter (B=A), then append "z" to the end
- SET INDL=$EXTRACT(INDXN,1,$LENGTH(INDXN)-1)_$CHAR($ASCII(INDXN,$LENGTH(INDXN))-1)_"z"
- +4 ; Order through the B index of the given file. If it nolonger matches the prefix or we hit the end of the B index quit
- FOR A=0:0
- SET INDL=$ORDER(@(INDFN_"""B"",INDL)"))
- if $PIECE(INDL,INDXN,1)]""!(INDL="")
- QUIT
- Begin DoDot:1
- +5 ; For each IEN in the B index
- FOR B=0:0
- SET B=$ORDER(@(INDFN_"""B"",INDL,B)"))
- if B=""
- QUIT
- Begin DoDot:2
- +6 ; Make sure it isn't an excluded namespace
- XECUTE INDF
- +7 ; If it isn't an excluded namesapce cross reference it
- if C8
- DO @INDSB
- End DoDot:2
- End DoDot:1
- +8 ; If there is only a header delete the faux routine
- IF INDLC=2
- KILL ^UTILITY($JOB,INDRN),^UTILITY($JOB,1,INDRN)
- QUIT
- +9 ; set the number of lines in the routine where the output will find it
- SET ^UTILITY($JOB,1,INDRN,0,0)=INDLC
- +10 QUIT
- NAMSP ; Setup processing for Indexing based on package file
- +1 ; PREFIX (#1) from Package File
- SET INDXN=$PIECE(^DIC(9.4,DA,0),"^",2)
- +2 ; Subscript for INDXN
- SET C9=0
- +3 ; 0th subscript is always ","
- SET INDXN(C9)=","
- +4 ; For each excluded name space in the package file
- FOR A=0:0
- SET A=$ORDER(^DIC(9.4,DA,"EX",A))
- if A'>0
- QUIT
- Begin DoDot:1
- +5 ; If there is an excluded namespace value
- IF $DATA(^(A,0))#2
- Begin DoDot:2
- +6 ; increment the counter
- SET C9=C9+1
- +7 ; set INDXN(COUNTER)=excluded namespace
- SET INDXN(C9)=$PIECE(^(0),"^")
- End DoDot:2
- End DoDot:1
- +8 ; Checks excluded namespaces
- SET INDF="S C8=1 F H=1:1:C9 I $P(INDL,INDXN(H))="""" S C8=0 Q"
- +9 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 SET ^UTILITY($JOB,1,INDRN,0,0)=INDLC
- +2 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
- ADDLN ;
- +1 SET INDLC=INDLC+1
- SET ^UTILITY($JOB,1,INDRN,0,INDLC,0)=" "_INDX
- +2 QUIT