- DICF2 ;SEA/TOAD,SF/TKW - VA FileMan: Finder, Part 3 (All Indexes) ;24SEP2016
- ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;;GFT;**4,20**;
- ;
- ;
- CHKALL(DIFILE,DIEN,DIFIEN,DIFLAGS,DIVALUE,DISCREEN,DINUMBER,DIFORCE,DINDEX,DIDENT,DILIST,DIC,DIY,DIYX) ;
- ; Loop through all indexes to be searched, perform data type
- ; transforms on lookup values.
- N DIOUT
- I DIFLAGS["O",DIFLAGS'["p" S DIOUT=DIFLAGS N DIFLAGS S DIFLAGS=DIOUT_"X"
- S DIOUT=0 N DISKIP
- 41 F D Q:$G(DIERR)!($G(DINDEX("DONE")))!DIOUT
- . S DISKIP=0
- . N DILINK S DILINK=DIFILE_U_DINDEX
- . I DINDEX="#" D
- . . S DIFILE("CHAIN",DILINK)=""
- . . Q:+$P(DIVALUE,"E")'=DIVALUE Q:'$D(@DIFILE(DIFILE)@(DIVALUE))
- . . N DIEN S DIEN=DIVALUE D ENTRY^DICF1 Q
- . I '$D(DIFILE("CHAIN",DILINK)) D K DIFILE("CHAIN",DILINK)
- . . S DIFILE("CHAIN",DILINK)=""
- . . D:DIFLAGS'["Q" PREPIX(.DIFILE,DIFLAGS,.DINDEX,.DIVALUE,.DISKIP)
- . . I 'DISKIP D CHKONE^DICF3(.DIFLAGS,.DIVALUE,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
- . . D CLEANIX(.DINDEX,.DIVALUE) Q
- 43 . I $G(DIERR)!($G(DINDEX("DONE"))) Q
- . I DIFLAGS["l" S (DIOUT,DINDEX("DONE"))=1 Q
- . D NXTINDX(.DINDEX,.DIFORCE,.DIFILE,.DIFLAGS,.DIVALUE,DINUMBER)
- . I DINDEX="" D Q:DINDEX=""
- . . S DIOUT=1
- . . Q:DIFLAGS'["O" Q:DIFLAGS'["X" Q:DIFLAGS["p" Q:DIDENT(-1)
- . . S DIFLAGS=$TR(DIFLAGS,"X"),DIOUT=0,DIFORCE(1)=1
- . . S DINDEX=$S(DIFLAGS["l":DINDEX("START"),DIFORCE:$P(DIFORCE(0),U),1:$$DINDEX^DICL(DIFILE,DIFLAGS))
- . . I DINDEX="" S DIOUT=1 Q
- . . D FIRSTIDX(.DINDEX,.DIFORCE,.DIFILE,DIFLAGS,.DIVALUE,DINUMBER)
- . . Q
- . D
- . . N DICRSR S DICRSR=0
- . . I DIFLAGS["P" D Q:'DICRSR
- . . . F S DICRSR=$O(DIDENT(DICRSR)) Q:'DICRSR Q:$D(DIDENT(DICRSR,0,1,"E"))
- . . . Q
- . . Q:'$D(DIDENT(DICRSR,0,1,"E"))
- . . N DISAVNO,DISAVENT S DISAVNO=DINDEX("#"),DINDEX("#")=1,DISAVENT=$G(DIDENT),DIDENT="IXE"
- . . D THROW^DICU11(DIFLAGS,.DIDENT,"IXE",DICRSR,1,"E",.DINDEX,1)
- . . S DINDEX("#")=DISAVNO,DIDENT=DISAVENT Q
- . Q
- Q
- ;
- PREPIX(DIFILE,DIFLAGS,DINDEX,DIVALUE,DISKIP) ;
- ; CHKALL--lookup index data type, add transform values to list
- N DISUB,DITYPE,DITRANEX
- F DISUB=1:1:DINDEX("#") D:DIVALUE(DISUB)]"" Q:$G(DIERR)
- . I $G(DINDEX("IXTYPE"))="S" D Q
- . . N X S X=$$SOUNDEX^DICF5(DINDEX(DISUB)) Q:'X
- . . S DIVALUE(DISUB,5)=X Q
- . S DITYPE=DINDEX(DISUB,"TYPE"),DITRANEX=$G(DINDEX(DISUB,"TRANEX"))
- . I DITYPE["F"!(DITYPE["N")!(DITRANEX]"") D
- . .N X,IX S IX=$G(DINDEX(DISUB,"TRANCODE")) I IX="" S IX=DITRANEX
- . . Q:IX=""
- . . S X=DIVALUE(DISUB) X IX Q:X=""
- . . S DIVALUE(DISUB,5)=X
- . . Q
- . N DINODE S DINODE=$G(^DD(+DINDEX(DISUB,"FILE"),+DINDEX(DISUB,"FIELD"),0))
- . I DITYPE["D" D PREPD^DICF5(DISUB,.DINDEX,DINODE,.DIVALUE) Q
- . I DITYPE["S" D PREPS^DICF5(DIFLAGS,DISUB,.DINDEX,DINODE,.DIVALUE) Q
- . I DITYPE'["P",DITYPE'["V" Q
- . I DISUB'=1 D POINT^DICF5(DISUB,DIFLAGS,.DIFILE,.DINDEX,.DIVALUE,.DISCREEN) Q
- . D POINT^DICF4(.DIFILE,.DIFLAGS,.DINDEX,.DIDENT,.DIEN,DIFIEN,.DISCREEN,.DIVALUE,.DIC,.DIFORCE)
- . I '$D(DINDEX(1,"IXROOT"))!($G(DIERR)) S DISKIP=1
- . I $G(DTOUT)!($G(DIROUT)) S (DISKIP,DINDEX("DONE"))=1
- . Q:DISKIP
- . Q:$G(DINDEX(1,"TRANCODE"))=""
- . N DII,X
- . S DII="" F S DII=$O(@DINDEX(1,"ROOT")@(DII)) Q:DII="" D
- . . K @DINDEX(1,"ROOT")@(DII)
- . . S X=$P(DII,"^",2) X DINDEX(1,"TRANCODE") Q:X=""
- . . S X=$P(DII,"^")_"^"_X,@DINDEX(1,"ROOT")@(X)="" Q
- . Q
- Q
- ;
- CLEANIX(DINDEX,DIVALUE) ;
- ; CHKALL--clear transform values for this index from DIVALUE arrays
- ; clear temporary list of pointed-to entries.
- N I,DISUB
- F DISUB=1:1:DINDEX("#") D
- . I $G(DINDEX(DISUB,"IXROOT"))]"" D
- . . I DISUB=1,DIFLAGS["l" S I=$O(@DINDEX(DISUB,"ROOT")@("")),DS("INT")=$P(I,U,2)
- . . S I=$P(DINDEX(DISUB,"ROOT"),",""B"")",1) Q:I=""
- . . K @(I_")") Q
- . S I=4
- . F S I=$O(DIVALUE(DISUB,I)) Q:'I K DIVALUE(DISUB,I)
- . Q
- Q
- ;
- FIRSTIDX(DINDEX,DIFORCE,DIFILE,DIFLAGS,DIVALUE,DINUMBER) ;
- ; Return data for starting index before second loop when flags["O"
- D N3 Q
- ;
- NXTINDX(DINDEX,DIFORCE,DIFILE,DIFLAGS,DIVALUE,DINUMBER) ;
- ; Return next index
- N D,DIGO,I,J,K,DIX1,DIX2,DIOK,DIOLDL
- S D=DINDEX,I=$G(DINDEX("START")),K=$G(DINDEX("MAXSUB"))
- D:DIFLAGS'["h"
- . F J=1:1:DINDEX("#") S DIOLDL(J)=DINDEX(J,"LENGTH")
- K DINDEX S DINDEX=D,DINDEX("WAY")=1
- S:I]"" DINDEX("START")=I S:K]"" DINDEX("MAXSUB")=K
- S (DIGO,DIOK)=0
- N1 I DIFORCE F D Q:DIOK!(DIGO)
- . I DIFLAGS["M",DIFORCE(1)=1,$P(DIFORCE(0),U,2)="" S DIGO=1 Q
- . S DIFORCE(1)=DIFORCE(1)+1,DINDEX=$P(DIFORCE(0),U,DIFORCE(1))
- . I DINDEX="#",DIFLAGS'["l",DIFLAGS'["h" S DIOK=1 Q
- . S:DINDEX=-1 DINDEX="" I DINDEX="" S DIOK=1 Q
- . I $O(^DD(DIFILE,0,"IX",DINDEX,0)),$$IDXOK(DIFILE,DINDEX) S DIOK=1 Q
- . S I=$O(^DD("IX","BB",DIFILE,DINDEX,0)) Q:'I
- . S DIOK=1 Q
- N2 I ('DIFORCE)!DIGO D
- . S (DIX1,DIX2)=DINDEX
- . F S DIX1=$O(^DD(DIFILE,0,"IX",DIX1)) Q:DIX1="" Q:$$IDXOK(DIFILE,DIX1)
- . S DIOK=0 F S DIX2=$O(^DD("IX","BB",DIFILE,DIX2)) Q:DIX2="" D Q:DIOK
- . . S I=$O(^DD("IX","BB",DIFILE,DIX2,0)) Q:'I
- . . Q:$P($G(^DD("IX",I,0)),U,14)'["L"
- . . S J=$O(^DD("IX",I,11.1,"AC",1,0)) Q:'J Q:$G(^DD("IX",I,11.1,J,0))=""
- . . S DIOK=1 Q
- . I DIX1'="",DIX2=""!(DIX2]DIX1) S DINDEX=DIX1 Q
- . S DINDEX=DIX2 Q
- . Q
- N3 Q:DINDEX="" Q:DIFLAGS["h"
- D INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,"",.DIVALUE,DINUMBER,.DISCREEN)
- I DINDEX("#")>1 F D=1:1:DINDEX("#") S DIVALUE(D)=$G(DIVALUE(D))
- N DINEWVAL S DINEWVAL=0 D
- . N J F J=1:1:DINDEX("#") I DIVALUE(J)]"",DINDEX(J,"LENGTH")'=$G(DIOLDL(J)) S DINEWVAL=1 Q
- . I DINEWVAL D XFORM^DICF1(DIFLAGS,.DIVALUE,.DISCREEN,.DINDEX)
- Q
- ;
- IDXOK(DIFILE,%) ; See whether selected index exists in 1 nodes of DD
- N DIX,%Y,DD,X Q:%="" 0
- S DIX=$O(^DD(DIFILE,0,"IX",%,0)) Q:'DIX 0
- S %Y=$O(^DD(DIFILE,0,"IX",%,DIX,0)) Q:'%Y 0
- F DD=0:0 S DD=$O(^DD(DIX,%Y,1,DD)) Q:'DD S X=$P($G(^(DD,0)),U,2) Q:X=%
- Q:'DD 0
- Q 1
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICF2 6115 printed Feb 19, 2025@00:12:17 Page 2
- DICF2 ;SEA/TOAD,SF/TKW - VA FileMan: Finder, Part 3 (All Indexes) ;24SEP2016
- +1 ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;;GFT;**4,20**;
- +7 ;
- +8 ;
- CHKALL(DIFILE,DIEN,DIFIEN,DIFLAGS,DIVALUE,DISCREEN,DINUMBER,DIFORCE,DINDEX,DIDENT,DILIST,DIC,DIY,DIYX) ;
- +1 ; Loop through all indexes to be searched, perform data type
- +2 ; transforms on lookup values.
- +3 NEW DIOUT
- +4 IF DIFLAGS["O"
- IF DIFLAGS'["p"
- SET DIOUT=DIFLAGS
- NEW DIFLAGS
- SET DIFLAGS=DIOUT_"X"
- +5 SET DIOUT=0
- NEW DISKIP
- 41 FOR
- Begin DoDot:1
- +1 SET DISKIP=0
- +2 NEW DILINK
- SET DILINK=DIFILE_U_DINDEX
- +3 IF DINDEX="#"
- Begin DoDot:2
- +4 SET DIFILE("CHAIN",DILINK)=""
- +5 if +$PIECE(DIVALUE,"E")'=DIVALUE
- QUIT
- if '$DATA(@DIFILE(DIFILE)@(DIVALUE))
- QUIT
- +6 NEW DIEN
- SET DIEN=DIVALUE
- DO ENTRY^DICF1
- QUIT
- End DoDot:2
- +7 IF '$DATA(DIFILE("CHAIN",DILINK))
- Begin DoDot:2
- +8 SET DIFILE("CHAIN",DILINK)=""
- +9 if DIFLAGS'["Q"
- DO PREPIX(.DIFILE,DIFLAGS,.DINDEX,.DIVALUE,.DISKIP)
- +10 IF 'DISKIP
- DO CHKONE^DICF3(.DIFLAGS,.DIVALUE,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
- +11 DO CLEANIX(.DINDEX,.DIVALUE)
- QUIT
- End DoDot:2
- KILL DIFILE("CHAIN",DILINK)
- 43 IF $GET(DIERR)!($GET(DINDEX("DONE")))
- QUIT
- +1 IF DIFLAGS["l"
- SET (DIOUT,DINDEX("DONE"))=1
- QUIT
- +2 DO NXTINDX(.DINDEX,.DIFORCE,.DIFILE,.DIFLAGS,.DIVALUE,DINUMBER)
- +3 IF DINDEX=""
- Begin DoDot:2
- +4 SET DIOUT=1
- +5 if DIFLAGS'["O"
- QUIT
- if DIFLAGS'["X"
- QUIT
- if DIFLAGS["p"
- QUIT
- if DIDENT(-1)
- QUIT
- +6 SET DIFLAGS=$TRANSLATE(DIFLAGS,"X")
- SET DIOUT=0
- SET DIFORCE(1)=1
- +7 SET DINDEX=$SELECT(DIFLAGS["l":DINDEX("START"),DIFORCE:$PIECE(DIFORCE(0),U),1:$$DINDEX^DICL(DIFILE,DIFLAGS))
- +8 IF DINDEX=""
- SET DIOUT=1
- QUIT
- +9 DO FIRSTIDX(.DINDEX,.DIFORCE,.DIFILE,DIFLAGS,.DIVALUE,DINUMBER)
- +10 QUIT
- End DoDot:2
- if DINDEX=""
- QUIT
- +11 Begin DoDot:2
- +12 NEW DICRSR
- SET DICRSR=0
- +13 IF DIFLAGS["P"
- Begin DoDot:3
- +14 FOR
- SET DICRSR=$ORDER(DIDENT(DICRSR))
- if 'DICRSR
- QUIT
- if $DATA(DIDENT(DICRSR,0,1,"E"))
- QUIT
- +15 QUIT
- End DoDot:3
- if 'DICRSR
- QUIT
- +16 if '$DATA(DIDENT(DICRSR,0,1,"E"))
- QUIT
- +17 NEW DISAVNO,DISAVENT
- SET DISAVNO=DINDEX("#")
- SET DINDEX("#")=1
- SET DISAVENT=$GET(DIDENT)
- SET DIDENT="IXE"
- +18 DO THROW^DICU11(DIFLAGS,.DIDENT,"IXE",DICRSR,1,"E",.DINDEX,1)
- +19 SET DINDEX("#")=DISAVNO
- SET DIDENT=DISAVENT
- QUIT
- End DoDot:2
- +20 QUIT
- End DoDot:1
- if $GET(DIERR)!($GET(DINDEX("DONE")))!DIOUT
- QUIT
- +21 QUIT
- +22 ;
- PREPIX(DIFILE,DIFLAGS,DINDEX,DIVALUE,DISKIP) ;
- +1 ; CHKALL--lookup index data type, add transform values to list
- +2 NEW DISUB,DITYPE,DITRANEX
- +3 FOR DISUB=1:1:DINDEX("#")
- if DIVALUE(DISUB)]""
- Begin DoDot:1
- +4 IF $GET(DINDEX("IXTYPE"))="S"
- Begin DoDot:2
- +5 NEW X
- SET X=$$SOUNDEX^DICF5(DINDEX(DISUB))
- if 'X
- QUIT
- +6 SET DIVALUE(DISUB,5)=X
- QUIT
- End DoDot:2
- QUIT
- +7 SET DITYPE=DINDEX(DISUB,"TYPE")
- SET DITRANEX=$GET(DINDEX(DISUB,"TRANEX"))
- +8 IF DITYPE["F"!(DITYPE["N")!(DITRANEX]"")
- Begin DoDot:2
- +9 NEW X,IX
- SET IX=$GET(DINDEX(DISUB,"TRANCODE"))
- IF IX=""
- SET IX=DITRANEX
- +10 if IX=""
- QUIT
- +11 SET X=DIVALUE(DISUB)
- XECUTE IX
- if X=""
- QUIT
- +12 SET DIVALUE(DISUB,5)=X
- +13 QUIT
- End DoDot:2
- +14 NEW DINODE
- SET DINODE=$GET(^DD(+DINDEX(DISUB,"FILE"),+DINDEX(DISUB,"FIELD"),0))
- +15 IF DITYPE["D"
- DO PREPD^DICF5(DISUB,.DINDEX,DINODE,.DIVALUE)
- QUIT
- +16 IF DITYPE["S"
- DO PREPS^DICF5(DIFLAGS,DISUB,.DINDEX,DINODE,.DIVALUE)
- QUIT
- +17 IF DITYPE'["P"
- IF DITYPE'["V"
- QUIT
- +18 IF DISUB'=1
- DO POINT^DICF5(DISUB,DIFLAGS,.DIFILE,.DINDEX,.DIVALUE,.DISCREEN)
- QUIT
- +19 DO POINT^DICF4(.DIFILE,.DIFLAGS,.DINDEX,.DIDENT,.DIEN,DIFIEN,.DISCREEN,.DIVALUE,.DIC,.DIFORCE)
- +20 IF '$DATA(DINDEX(1,"IXROOT"))!($GET(DIERR))
- SET DISKIP=1
- +21 IF $GET(DTOUT)!($GET(DIROUT))
- SET (DISKIP,DINDEX("DONE"))=1
- +22 if DISKIP
- QUIT
- +23 if $GET(DINDEX(1,"TRANCODE"))=""
- QUIT
- +24 NEW DII,X
- +25 SET DII=""
- FOR
- SET DII=$ORDER(@DINDEX(1,"ROOT")@(DII))
- if DII=""
- QUIT
- Begin DoDot:2
- +26 KILL @DINDEX(1,"ROOT")@(DII)
- +27 SET X=$PIECE(DII,"^",2)
- XECUTE DINDEX(1,"TRANCODE")
- if X=""
- QUIT
- +28 SET X=$PIECE(DII,"^")_"^"_X
- SET @DINDEX(1,"ROOT")@(X)=""
- QUIT
- End DoDot:2
- +29 QUIT
- End DoDot:1
- if $GET(DIERR)
- QUIT
- +30 QUIT
- +31 ;
- CLEANIX(DINDEX,DIVALUE) ;
- +1 ; CHKALL--clear transform values for this index from DIVALUE arrays
- +2 ; clear temporary list of pointed-to entries.
- +3 NEW I,DISUB
- +4 FOR DISUB=1:1:DINDEX("#")
- Begin DoDot:1
- +5 IF $GET(DINDEX(DISUB,"IXROOT"))]""
- Begin DoDot:2
- +6 IF DISUB=1
- IF DIFLAGS["l"
- SET I=$ORDER(@DINDEX(DISUB,"ROOT")@(""))
- SET DS("INT")=$PIECE(I,U,2)
- +7 SET I=$PIECE(DINDEX(DISUB,"ROOT"),",""B"")",1)
- if I=""
- QUIT
- +8 KILL @(I_")")
- QUIT
- End DoDot:2
- +9 SET I=4
- +10 FOR
- SET I=$ORDER(DIVALUE(DISUB,I))
- if 'I
- QUIT
- KILL DIVALUE(DISUB,I)
- +11 QUIT
- End DoDot:1
- +12 QUIT
- +13 ;
- FIRSTIDX(DINDEX,DIFORCE,DIFILE,DIFLAGS,DIVALUE,DINUMBER) ;
- +1 ; Return data for starting index before second loop when flags["O"
- +2 DO N3
- QUIT
- +3 ;
- NXTINDX(DINDEX,DIFORCE,DIFILE,DIFLAGS,DIVALUE,DINUMBER) ;
- +1 ; Return next index
- +2 NEW D,DIGO,I,J,K,DIX1,DIX2,DIOK,DIOLDL
- +3 SET D=DINDEX
- SET I=$GET(DINDEX("START"))
- SET K=$GET(DINDEX("MAXSUB"))
- +4 if DIFLAGS'["h"
- Begin DoDot:1
- +5 FOR J=1:1:DINDEX("#")
- SET DIOLDL(J)=DINDEX(J,"LENGTH")
- End DoDot:1
- +6 KILL DINDEX
- SET DINDEX=D
- SET DINDEX("WAY")=1
- +7 if I]""
- SET DINDEX("START")=I
- if K]""
- SET DINDEX("MAXSUB")=K
- +8 SET (DIGO,DIOK)=0
- N1 IF DIFORCE
- FOR
- Begin DoDot:1
- +1 IF DIFLAGS["M"
- IF DIFORCE(1)=1
- IF $PIECE(DIFORCE(0),U,2)=""
- SET DIGO=1
- QUIT
- +2 SET DIFORCE(1)=DIFORCE(1)+1
- SET DINDEX=$PIECE(DIFORCE(0),U,DIFORCE(1))
- +3 IF DINDEX="#"
- IF DIFLAGS'["l"
- IF DIFLAGS'["h"
- SET DIOK=1
- QUIT
- +4 if DINDEX=-1
- SET DINDEX=""
- IF DINDEX=""
- SET DIOK=1
- QUIT
- +5 IF $ORDER(^DD(DIFILE,0,"IX",DINDEX,0))
- IF $$IDXOK(DIFILE,DINDEX)
- SET DIOK=1
- QUIT
- +6 SET I=$ORDER(^DD("IX","BB",DIFILE,DINDEX,0))
- if 'I
- QUIT
- +7 SET DIOK=1
- QUIT
- End DoDot:1
- if DIOK!(DIGO)
- QUIT
- N2 IF ('DIFORCE)!DIGO
- Begin DoDot:1
- +1 SET (DIX1,DIX2)=DINDEX
- +2 FOR
- SET DIX1=$ORDER(^DD(DIFILE,0,"IX",DIX1))
- if DIX1=""
- QUIT
- if $$IDXOK(DIFILE,DIX1)
- QUIT
- +3 SET DIOK=0
- FOR
- SET DIX2=$ORDER(^DD("IX","BB",DIFILE,DIX2))
- if DIX2=""
- QUIT
- Begin DoDot:2
- +4 SET I=$ORDER(^DD("IX","BB",DIFILE,DIX2,0))
- if 'I
- QUIT
- +5 if $PIECE($GET(^DD("IX",I,0)),U,14)'["L"
- QUIT
- +6 SET J=$ORDER(^DD("IX",I,11.1,"AC",1,0))
- if 'J
- QUIT
- if $GET(^DD("IX",I,11.1,J,0))=""
- QUIT
- +7 SET DIOK=1
- QUIT
- End DoDot:2
- if DIOK
- QUIT
- +8 IF DIX1'=""
- IF DIX2=""!(DIX2]DIX1)
- SET DINDEX=DIX1
- QUIT
- +9 SET DINDEX=DIX2
- QUIT
- +10 QUIT
- End DoDot:1
- N3 if DINDEX=""
- QUIT
- if DIFLAGS["h"
- QUIT
- +1 DO INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,"",.DIVALUE,DINUMBER,.DISCREEN)
- +2 IF DINDEX("#")>1
- FOR D=1:1:DINDEX("#")
- SET DIVALUE(D)=$GET(DIVALUE(D))
- +3 NEW DINEWVAL
- SET DINEWVAL=0
- Begin DoDot:1
- +4 NEW J
- FOR J=1:1:DINDEX("#")
- IF DIVALUE(J)]""
- IF DINDEX(J,"LENGTH")'=$GET(DIOLDL(J))
- SET DINEWVAL=1
- QUIT
- +5 IF DINEWVAL
- DO XFORM^DICF1(DIFLAGS,.DIVALUE,.DISCREEN,.DINDEX)
- End DoDot:1
- +6 QUIT
- +7 ;
- IDXOK(DIFILE,%) ; See whether selected index exists in 1 nodes of DD
- +1 NEW DIX,%Y,DD,X
- if %=""
- QUIT 0
- +2 SET DIX=$ORDER(^DD(DIFILE,0,"IX",%,0))
- if 'DIX
- QUIT 0
- +3 SET %Y=$ORDER(^DD(DIFILE,0,"IX",%,DIX,0))
- if '%Y
- QUIT 0
- +4 FOR DD=0:0
- SET DD=$ORDER(^DD(DIX,%Y,1,DD))
- if 'DD
- QUIT
- SET X=$PIECE($GET(^(DD,0)),U,2)
- if X=%
- QUIT
- +5 if 'DD
- QUIT 0
- +6 QUIT 1
- +7 ;