DIC ;SFISC/XAK,TKW,SEA/TOAD-VA FileMan: Lookup, Part 1 ;12SEP2013
 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
 ;;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.
 ;
 N %,D,DF,DIFILEI,DIENS,DINDEX,DS,DIASKOK,DIY,DO S U="^",DIC(0)=$G(DIC(0))
 D GETFILE^DIC0(.DIC,.DIFILEI,.DIENS) I DIFILEI="" S Y=-1 Q
 S %=$P("K^",U,DIC(0)["K"),(D,DINDEX,DINDEX("START"))=$$DINDEX^DICL(DIFILEI,%) ;ASSUMES A "B" CROSS-REFERENCE
 K %
EN I $G(DIFILEI)=""!('$D(DINDEX)#2) N DIFILEI,DIENS,DINDEX,DIASKOK,%
 K DO,DICR,DIROUT,DTOUT,DUOUT S U="^"
 D INIT^DIC0 I DIFILEI="" S Y=-1 D Q^DIC2 Q
 S DIC(0)=$G(DIC(0)) D
 . I DIC(0)["T" K ^TMP($J,"DICSEEN") S ^TMP($J,"DICSEEN",DIFILEI)=""
 . I $D(ZTQUEUED),$E($G(IOST),1,2)'="C-" S DIC(0)=$TR(DIC(0),"AEQ")
 . I DIC(0)["X",DIC(0)["O" S DIC(0)=$TR(DIC(0),"O")
 . S:DINDEX("#")>1 DIC(0)=$TR(DIC(0),"M") Q
 N DIPGM S DIPGM=$$PGM^DIC2(.DIC,$G(DF),DIFILEI)
 I DIPGM]"" D KILL1^DIC0 K DIC("W") S DIPGM(0)=1 G @DIPGM
ASK I $G(DIFILEI)=""!('$D(DINDEX)#2) N DIFILEI,DIENS,DINDEX,DIASKOK,% D INIT^DIC0 I DIFILEI="" S Y=-1 D Q^DIC2 Q
 I '$D(DIVAL) N DIVAL,DIALLVAL
 K DIVAL,DIALLVAL S DIVAL(0)=0,Y=-1,DIALLVAL=1
 I DIC(0)["A" K X W ! D ^DIC1 I $G(DTOUT) D Q^DIC2 Q
 I DIC(0)'["A" D CHKVAL^DIC0,CHKVAL2^DIC0(DINDEX("#"),.DIVAL,DIC(0),.DDS)
A1 I DIVAL(0) D
 . D CHKVAL1^DIC0(DINDEX("#"),.DIVAL,DIC(0),DIC(0),.DIALLVAL) Q:'DIVAL(0)
 . I $D(DIADD),X]"",X'["""" S (X,DIVAL(1))=""""_X_"""" S:DINDEX("#")>1 X(1)=X
 . N DUOUT K DINDEX S (DINDEX,DINDEX("START"))=D,DINDEX("WAY")=1
 . D INDEX^DICUIX(.DIFILEI,"4l",.DINDEX,"",.DIVAL) Q
X ;from DICM0
 I $G(DIFILEI)=""!('$D(DINDEX)#2) K DUOUT,DTOUT N DIFILEI,DIENS,DINDEX,DIASKOK,% N:'$D(DIVAL(0)) DIVAL,DIALLVAL D  I DIFILEI="" S Y=-1 D Q^DIC2 Q
 . D INIT^DIC0 Q:$D(DIVAL(0))!(DIFILEI="")
 . D SETVAL^DIC0 Q
 I DIVAL(0),$D(^DD(DIFILEI,.01,7.5)) X ^(7.5) D NODE75^DIC5 I $G(X)="" G:DIC(0)["A" ASK D Q^DIC2 Q
 N DIPGM S DIPGM=$S(DIVAL(0)'>1:$$PGM^DIC2(.DIC,$G(DF),DIFILEI),1:"")
 I DIPGM]"" D KILL2^DIC0 S DIPGM(0)=2 G @DIPGM
RTN I $G(DIFILEI)=""!('$D(DINDEX)#2) N DIFILEI,DIENS,DINDEX,DIASKOK,% N:'$D(DIVAL(0)) DIVAL,DIALLVAL D  I DIFILEI="" S Y=-1 D Q^DIC2 Q
 . D INIT^DIC0 Q:$D(DIVAL(0))!(DIFILEI="")
 . D SETVAL^DIC0 Q
 I X?1."?" D  Q:$G(DTOUT)  G:DIC(0)["A" ASK Q
 . D DSPHLP^DICQ(.DIC,.DIFILEI,.DINDEX,X)
 . S Y=-1 Q
 I DIVAL(0)=0!($G(DUOUT)) S Y=-1 D Q^DIC2 Q
 D:'$D(DO(2)) GETFA^DIC1(.DIC,.DO)
GRV I X?1"`".NP S Y=-1 G DBLGRV:X?1"``".E&(DO(2)["P") D BYIEN1^DIC5 Q:Y>0  I '$$TRYADD^DIC11(.DIC,DIFILEI) D DING G:DIC(0)["A" ASK D Q^DIC2 Q
 I DIVAL(0)=1,+$P(X,"E")=X,X>0 S Y=-1 N DISKIPIX D BYIEN2^DIC5 Q:Y>0
 I X=" ",$L(DIC)<29,$D(^DISV(DUZ,DIC))#2 S Y=+^(DIC) D SPACEBAR^DIC5 Q:Y>0  D DING G:DIC(0)["A" ASK D Q^DIC2 Q
F ; Start regular lookup
 N DD,DS,DIX,DIY,DIYX,DIDONE,DISAVDS,%Y,%H,DISYS
 I $G(DIFILEI)=""!('$D(DINDEX)#2) N DIFILEI,DIENS,DINDEX,DIASKOK,% N:'$D(DIVAL(0)) DIVAL,DIALLVAL D
 . D INIT^DIC0 Q:$D(DIVAL(0))
 . D SETVAL^DIC0 Q
F1 S (DD,DS,DS(0),DS("DD"))=0
 D SEARCH^DIC3
 I $G(DTOUT)!(Y'<0) D Q^DIC2 Q
 I $P(DS(0),U,2)="?",(DIC(0)_$G(DICR(1,0)))'["A" D K,INDEX^DICUIX(.DIFILEI,"4l",.DINDEX,"",.DIVAL) G F1 ;**170
 I +DS(0)=2 S X=$P(DS(0),U,2) D K D  G A1
 . K DIVAL,DIALLVAL S DIVAL(0)=0,Y=-1,DIALLVAL=1
 . D CHKVAL^DIC0,CHKVAL2^DIC0(DINDEX("#"),.DIVAL,DIC(0),.DDS)
 . Q
 D  D K I Y<0,DIC(0)["A" D D^DIC0 W:DIC(0)["E" ! K:$D(DIROUT) DIROUT G ASK
 . Q:$G(DIROUT)
 . I DS(0),$P(DS(0),U,2)="" S:DIC(0)["Y"&($O(Y(0))) Y=0 D DING Q
 . Q:'($D(DS)#2)
 . I (DS(0)=0!($P(DS(0),U,2)="U")),DS("DD")=DS,(DO(2)["O"!($G(DIASKOK))!(DIC(0)["T")),DO(2)'["A",DO(2)'["P",DO(2)'["V",DO(2)'["D",DO(2)'["S",DIC(0)["L" D L^DICM
 . Q
 D Q^DIC2 Q
 ;
 ;
DBLGRV S X=$E(X,2,999) S:'$D(DICR(1)) DICR=0 S %="B",DS=^DD(+DO(2),.01,0) D A^DICM K DO S DO="DUMMY" D P^DICM0 S DIC(0)="U"_DIC(0) D D^DICM I Y>0 G K^DICM ;RECURSIVE LOOKUP ON THE SECOND `
NOGOOD D DING G:DIC(0)["A" ASK D Q^DIC2 Q
 ;
 ;
K K DD,DS,DIX,DIY,DIYX,DIDONE,DISAVDS
 I '$G(DICR),DIC(0)["T" K ^TMP($J,"DICSEEN") S ^TMP($J,"DICSEEN",DIFILEI)=""
 Q
 ;
DING Q:DIC(0)'["Q"!(DIC(0)'["E")
 W:'$D(DUOUT) $C(7)_$S('$D(DDS):" ??",1:"") Q
 ;
 ;
IX N DINDEX,DF
 S (DF,DINDEX,DINDEX("START"))=D
 G EN
 ;
A K DIY,DIYX,DS I DIC(0)["A" D D^DIC0 Q
NO S Y=-1 D Q^DIC2 Q
 ;
 ; DBS Entry points
LIST(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DINUMBER,DIFROM,DIPART,DINDEX,DISCREEN,DIWRITE,DILIST,DIMSGA) ;
 ;ENTRY POINT--return a list of entries from a file  (SEA/TOAD)
 G IN^DICL
 ;
FIND1(DIFILE,DIFIEN,DIFLAGS,DIVALUE,DIFORCE,DISCREEN,DIMSGA) ;SEA/TOAD
 ;ENTRY POINT--find a single entry in the file
 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
 N DICLERR S DICLERR=$G(DIERR) K DIERR
 N DIERN,DIFIND,DIPE,DITARGET
 N DIVALS M DIVALS=DIVALUE I $G(DIVALS)="" S DIVALS=$G(DIVALUE(1))
 D FIND^DICF($G(DIFILE),$G(DIFIEN),"",$G(DIFLAGS)_"f",.DIVALUE,1,$G(DIFORCE),.DISCREEN,"","DITARGET")
 I $D(DIERR) S DIFIND=""
 E  I $P($G(DITARGET(0)),U,3) K DITARGET S DIFIND="" D
 . I $O(DIVALS(1)) N I F I=1:0 S I=$O(DIVALS(I)) Q:'I  D:DIVALS(I)]""  Q:'I
 . . I ($L(DIVALS)+$L(DIVALS(I)))>100 S DIVALS=DIVALS_"...",I="" Q
 . . S DIVALS=DIVALS_$P(", ^",U,DIVALS]"")_DIVALS(I) Q
 . D ERR^DICF4(299,$G(DIFILE),$G(DIFIEN),"",DIVALS)
 . Q
 E  S DIFIND=+$G(DITARGET(1))
 I DICLERR'=""!$G(DIERR) D
 . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
 I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
 Q DIFIND
 ;
FIND(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DIVALUE,DINUMBER,DIFORCE,DISCREEN,DIWRITE,DILIST,DIMSGA) ;SEA/TOAD
 ;ENTRY POINT--in a file find entries that match a value
 G FINDX^DICF
 ;
 ; Error messages:
 ; 299  More than one entry matches the value(s) '|1|'
 ; 120  The previous error occurred when performing
 ; 8090 Pre-lookup transform (7.5 node)
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIC   5983     printed  Sep 23, 2025@20:21:22                                                                                                                                                                                                         Page 2
DIC       ;SFISC/XAK,TKW,SEA/TOAD-VA FileMan: Lookup, Part 1 ;12SEP2013
 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
 +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       ;
 +7        NEW %,D,DF,DIFILEI,DIENS,DINDEX,DS,DIASKOK,DIY,DO
           SET U="^"
           SET DIC(0)=$GET(DIC(0))
 +8        DO GETFILE^DIC0(.DIC,.DIFILEI,.DIENS)
           IF DIFILEI=""
               SET Y=-1
               QUIT 
 +9       ;ASSUMES A "B" CROSS-REFERENCE
           SET %=$PIECE("K^",U,DIC(0)["K")
           SET (D,DINDEX,DINDEX("START"))=$$DINDEX^DICL(DIFILEI,%)
 +10       KILL %
EN         IF $GET(DIFILEI)=""!('$DATA(DINDEX)#2)
               NEW DIFILEI,DIENS,DINDEX,DIASKOK,%
 +1        KILL DO,DICR,DIROUT,DTOUT,DUOUT
           SET U="^"
 +2        DO INIT^DIC0
           IF DIFILEI=""
               SET Y=-1
               DO Q^DIC2
               QUIT 
 +3        SET DIC(0)=$GET(DIC(0))
           Begin DoDot:1
 +4            IF DIC(0)["T"
                   KILL ^TMP($JOB,"DICSEEN")
                   SET ^TMP($JOB,"DICSEEN",DIFILEI)=""
 +5            IF $DATA(ZTQUEUED)
                   IF $EXTRACT($GET(IOST),1,2)'="C-"
                       SET DIC(0)=$TRANSLATE(DIC(0),"AEQ")
 +6            IF DIC(0)["X"
                   IF DIC(0)["O"
                       SET DIC(0)=$TRANSLATE(DIC(0),"O")
 +7            if DINDEX("#")>1
                   SET DIC(0)=$TRANSLATE(DIC(0),"M")
               QUIT 
           End DoDot:1
 +8        NEW DIPGM
           SET DIPGM=$$PGM^DIC2(.DIC,$GET(DF),DIFILEI)
 +9        IF DIPGM]""
               DO KILL1^DIC0
               KILL DIC("W")
               SET DIPGM(0)=1
               GOTO @DIPGM
ASK        IF $GET(DIFILEI)=""!('$DATA(DINDEX)#2)
               NEW DIFILEI,DIENS,DINDEX,DIASKOK,%
               DO INIT^DIC0
               IF DIFILEI=""
                   SET Y=-1
                   DO Q^DIC2
                   QUIT 
 +1        IF '$DATA(DIVAL)
               NEW DIVAL,DIALLVAL
 +2        KILL DIVAL,DIALLVAL
           SET DIVAL(0)=0
           SET Y=-1
           SET DIALLVAL=1
 +3        IF DIC(0)["A"
               KILL X
               WRITE !
               DO ^DIC1
               IF $GET(DTOUT)
                   DO Q^DIC2
                   QUIT 
 +4        IF DIC(0)'["A"
               DO CHKVAL^DIC0
               DO CHKVAL2^DIC0(DINDEX("#"),.DIVAL,DIC(0),.DDS)
A1         IF DIVAL(0)
               Begin DoDot:1
 +1                DO CHKVAL1^DIC0(DINDEX("#"),.DIVAL,DIC(0),DIC(0),.DIALLVAL)
                   if 'DIVAL(0)
                       QUIT 
 +2                IF $DATA(DIADD)
                       IF X]""
                           IF X'[""""
                               SET (X,DIVAL(1))=""""_X_""""
                               if DINDEX("#")>1
                                   SET X(1)=X
 +3                NEW DUOUT
                   KILL DINDEX
                   SET (DINDEX,DINDEX("START"))=D
                   SET DINDEX("WAY")=1
 +4                DO INDEX^DICUIX(.DIFILEI,"4l",.DINDEX,"",.DIVAL)
                   QUIT 
               End DoDot:1
X         ;from DICM0
 +1        IF $GET(DIFILEI)=""!('$DATA(DINDEX)#2)
               KILL DUOUT,DTOUT
               NEW DIFILEI,DIENS,DINDEX,DIASKOK,%
               if '$DATA(DIVAL(0))
                   NEW DIVAL,DIALLVAL
               Begin DoDot:1
 +2                DO INIT^DIC0
                   if $DATA(DIVAL(0))!(DIFILEI="")
                       QUIT 
 +3                DO SETVAL^DIC0
                   QUIT 
               End DoDot:1
               IF DIFILEI=""
                   SET Y=-1
                   DO Q^DIC2
                   QUIT 
 +4        IF DIVAL(0)
               IF $DATA(^DD(DIFILEI,.01,7.5))
                   XECUTE ^(7.5)
                   DO NODE75^DIC5
                   IF $GET(X)=""
                       if DIC(0)["A"
                           GOTO ASK
                       DO Q^DIC2
                       QUIT 
 +5        NEW DIPGM
           SET DIPGM=$SELECT(DIVAL(0)'>1:$$PGM^DIC2(.DIC,$GET(DF),DIFILEI),1:"")
 +6        IF DIPGM]""
               DO KILL2^DIC0
               SET DIPGM(0)=2
               GOTO @DIPGM
RTN        IF $GET(DIFILEI)=""!('$DATA(DINDEX)#2)
               NEW DIFILEI,DIENS,DINDEX,DIASKOK,%
               if '$DATA(DIVAL(0))
                   NEW DIVAL,DIALLVAL
               Begin DoDot:1
 +1                DO INIT^DIC0
                   if $DATA(DIVAL(0))!(DIFILEI="")
                       QUIT 
 +2                DO SETVAL^DIC0
                   QUIT 
               End DoDot:1
               IF DIFILEI=""
                   SET Y=-1
                   DO Q^DIC2
                   QUIT 
 +3        IF X?1."?"
               Begin DoDot:1
 +4                DO DSPHLP^DICQ(.DIC,.DIFILEI,.DINDEX,X)
 +5                SET Y=-1
                   QUIT 
               End DoDot:1
               if $GET(DTOUT)
                   QUIT 
               if DIC(0)["A"
                   GOTO ASK
               QUIT 
 +6        IF DIVAL(0)=0!($GET(DUOUT))
               SET Y=-1
               DO Q^DIC2
               QUIT 
 +7        if '$DATA(DO(2))
               DO GETFA^DIC1(.DIC,.DO)
GRV        IF X?1"`".NP
               SET Y=-1
               if X?1"``".E&(DO(2)["P")
                   GOTO DBLGRV
               DO BYIEN1^DIC5
               if Y>0
                   QUIT 
               IF '$$TRYADD^DIC11(.DIC,DIFILEI)
                   DO DING
                   if DIC(0)["A"
                       GOTO ASK
                   DO Q^DIC2
                   QUIT 
 +1        IF DIVAL(0)=1
               IF +$PIECE(X,"E")=X
                   IF X>0
                       SET Y=-1
                       NEW DISKIPIX
                       DO BYIEN2^DIC5
                       if Y>0
                           QUIT 
 +2        IF X=" "
               IF $LENGTH(DIC)<29
                   IF $DATA(^DISV(DUZ,DIC))#2
                       SET Y=+^(DIC)
                       DO SPACEBAR^DIC5
                       if Y>0
                           QUIT 
                       DO DING
                       if DIC(0)["A"
                           GOTO ASK
                       DO Q^DIC2
                       QUIT 
F         ; Start regular lookup
 +1        NEW DD,DS,DIX,DIY,DIYX,DIDONE,DISAVDS,%Y,%H,DISYS
 +2        IF $GET(DIFILEI)=""!('$DATA(DINDEX)#2)
               NEW DIFILEI,DIENS,DINDEX,DIASKOK,%
               if '$DATA(DIVAL(0))
                   NEW DIVAL,DIALLVAL
               Begin DoDot:1
 +3                DO INIT^DIC0
                   if $DATA(DIVAL(0))
                       QUIT 
 +4                DO SETVAL^DIC0
                   QUIT 
               End DoDot:1
F1         SET (DD,DS,DS(0),DS("DD"))=0
 +1        DO SEARCH^DIC3
 +2        IF $GET(DTOUT)!(Y'<0)
               DO Q^DIC2
               QUIT 
 +3       ;**170
           IF $PIECE(DS(0),U,2)="?"
               IF (DIC(0)_$GET(DICR(1,0)))'["A"
                   DO K
                   DO INDEX^DICUIX(.DIFILEI,"4l",.DINDEX,"",.DIVAL)
                   GOTO F1
 +4        IF +DS(0)=2
               SET X=$PIECE(DS(0),U,2)
               DO K
               Begin DoDot:1
 +5                KILL DIVAL,DIALLVAL
                   SET DIVAL(0)=0
                   SET Y=-1
                   SET DIALLVAL=1
 +6                DO CHKVAL^DIC0
                   DO CHKVAL2^DIC0(DINDEX("#"),.DIVAL,DIC(0),.DDS)
 +7                QUIT 
               End DoDot:1
               GOTO A1
 +8        Begin DoDot:1
 +9            if $GET(DIROUT)
                   QUIT 
 +10           IF DS(0)
                   IF $PIECE(DS(0),U,2)=""
                       if DIC(0)["Y"&($ORDER(Y(0)))
                           SET Y=0
                       DO DING
                       QUIT 
 +11           if '($DATA(DS)#2)
                   QUIT 
 +12           IF (DS(0)=0!($PIECE(DS(0),U,2)="U"))
                   IF DS("DD")=DS
                       IF (DO(2)["O"!($GET(DIASKOK))!(DIC(0)["T"))
                           IF DO(2)'["A"
                               IF DO(2)'["P"
                                   IF DO(2)'["V"
                                       IF DO(2)'["D"
                                           IF DO(2)'["S"
                                               IF DIC(0)["L"
                                                   DO L^DICM
 +13           QUIT 
           End DoDot:1
           DO K
           IF Y<0
               IF DIC(0)["A"
                   DO D^DIC0
                   if DIC(0)["E"
                       WRITE !
                   if $DATA(DIROUT)
                       KILL DIROUT
                   GOTO ASK
 +14       DO Q^DIC2
           QUIT 
 +15      ;
 +16      ;
DBLGRV    ;RECURSIVE LOOKUP ON THE SECOND `
           SET X=$EXTRACT(X,2,999)
           if '$DATA(DICR(1))
               SET DICR=0
           SET %="B"
           SET DS=^DD(+DO(2),.01,0)
           DO A^DICM
           KILL DO
           SET DO="DUMMY"
           DO P^DICM0
           SET DIC(0)="U"_DIC(0)
           DO D^DICM
           IF Y>0
               GOTO K^DICM
NOGOOD     DO DING
           if DIC(0)["A"
               GOTO ASK
           DO Q^DIC2
           QUIT 
 +1       ;
 +2       ;
K          KILL DD,DS,DIX,DIY,DIYX,DIDONE,DISAVDS
 +1        IF '$GET(DICR)
               IF DIC(0)["T"
                   KILL ^TMP($JOB,"DICSEEN")
                   SET ^TMP($JOB,"DICSEEN",DIFILEI)=""
 +2        QUIT 
 +3       ;
DING       if DIC(0)'["Q"!(DIC(0)'["E")
               QUIT 
 +1        if '$DATA(DUOUT)
               WRITE $CHAR(7)_$SELECT('$DATA(DDS):" ??",1:"")
           QUIT 
 +2       ;
 +3       ;
IX         NEW DINDEX,DF
 +1        SET (DF,DINDEX,DINDEX("START"))=D
 +2        GOTO EN
 +3       ;
A          KILL DIY,DIYX,DS
           IF DIC(0)["A"
               DO D^DIC0
               QUIT 
NO         SET Y=-1
           DO Q^DIC2
           QUIT 
 +1       ;
 +2       ; DBS Entry points
LIST(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DINUMBER,DIFROM,DIPART,DINDEX,DISCREEN,DIWRITE,DILIST,DIMSGA) ;
 +1       ;ENTRY POINT--return a list of entries from a file  (SEA/TOAD)
 +2        GOTO IN^DICL
 +3       ;
FIND1(DIFILE,DIFIEN,DIFLAGS,DIVALUE,DIFORCE,DISCREEN,DIMSGA) ;SEA/TOAD
 +1       ;ENTRY POINT--find a single entry in the file
 +2        IF '$DATA(DIQUIET)
               NEW DIQUIET
               SET DIQUIET=1
 +3        IF '$DATA(DIFM)
               NEW DIFM
               SET DIFM=1
               DO INIZE^DIEFU
 +4        NEW DICLERR
           SET DICLERR=$GET(DIERR)
           KILL DIERR
 +5        NEW DIERN,DIFIND,DIPE,DITARGET
 +6        NEW DIVALS
           MERGE DIVALS=DIVALUE
           IF $GET(DIVALS)=""
               SET DIVALS=$GET(DIVALUE(1))
 +7        DO FIND^DICF($GET(DIFILE),$GET(DIFIEN),"",$GET(DIFLAGS)_"f",.DIVALUE,1,$GET(DIFORCE),.DISCREEN,"","DITARGET")
 +8        IF $DATA(DIERR)
               SET DIFIND=""
 +9       IF '$TEST
               IF $PIECE($GET(DITARGET(0)),U,3)
                   KILL DITARGET
                   SET DIFIND=""
                   Begin DoDot:1
 +10                   IF $ORDER(DIVALS(1))
                           NEW I
                           FOR I=1:0
                               SET I=$ORDER(DIVALS(I))
                               if 'I
                                   QUIT 
                               if DIVALS(I)]""
                                   Begin DoDot:2
 +11                                   IF ($LENGTH(DIVALS)+$LENGTH(DIVALS(I)))>100
                                           SET DIVALS=DIVALS_"..."
                                           SET I=""
                                           QUIT 
 +12                                   SET DIVALS=DIVALS_$PIECE(", ^",U,DIVALS]"")_DIVALS(I)
                                       QUIT 
                                   End DoDot:2
                               if 'I
                                   QUIT 
 +13                   DO ERR^DICF4(299,$GET(DIFILE),$GET(DIFIEN),"",DIVALS)
 +14                   QUIT 
                   End DoDot:1
 +15      IF '$TEST
               SET DIFIND=+$GET(DITARGET(1))
 +16       IF DICLERR'=""!$GET(DIERR)
               Begin DoDot:1
 +17               SET DIERR=$GET(DIERR)+DICLERR_U_($PIECE($GET(DIERR),U,2)+$PIECE(DICLERR,U,2))
               End DoDot:1
 +18       IF $GET(DIMSGA)'=""
               DO CALLOUT^DIEFU(DIMSGA)
 +19       QUIT DIFIND
 +20      ;
FIND(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DIVALUE,DINUMBER,DIFORCE,DISCREEN,DIWRITE,DILIST,DIMSGA) ;SEA/TOAD
 +1       ;ENTRY POINT--in a file find entries that match a value
 +2        GOTO FINDX^DICF
 +3       ;
 +4       ; Error messages:
 +5       ; 299  More than one entry matches the value(s) '|1|'
 +6       ; 120  The previous error occurred when performing
 +7       ; 8090 Pre-lookup transform (7.5 node)
 +8       ;