- 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 Dec 13, 2024@02:45:16 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 ;