DICF ;VEN/TOAD,SF/TKW - Lookup: Finder, Part 1 (Main) ;1/24/13 3:51pm
;;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.
;
;
; Contents
;
; $$FIND/FINDX/INPUT/HOOK75/LOOKUP: Finder Implementation
; $$BADVAL: Validate a Lookup Value
; CLOSE: Cleanup before Exiting Finder
;
;
FIND(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DIVALUE,DINUMBER,DIFORCE,DISCREEN,DIWRITE,DILIST,DIMSGA,DINDEX,DIC,DIY,DIYX) ;
; Finder Implementation [internal use only]
;
FINDX ; 1. Finder Pre-initialization [from FIND or FIND^DIC]
;
I '$D(DIQUIET),$G(DIC(0))'["E" 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 DIDENT S DIDENT(-1)=+$G(DILIST("C"))
;
INPUT ; 2. Validate Input Parameters
;
N DIEN M DIEN=DIVALUE N DIVALUE M DIVALUE=DIEN K DIEN
S DIFLAGS=$G(DIFLAGS) ; Validate Flags (DIFLAGS), part 1 of 3
I DIFLAGS'["l" N DINDEX S DINDEX("WAY")=1
;
N DIFAIL S DIFAIL=0
D I DIFAIL D CLOSE Q
. ;
I1 . ; 2.1. Validate Flags (DIFLAGS), part 2 of 3
. ;
. I DIFLAGS["p" S DIFLAGS=DIFLAGS_"f"
. I DIFLAGS'["p" D Q:DIFAIL
. . I $G(DIFIELDS)["IX",DIFIELDS'["-IX" D
. . . N D S D=";"_DIFIELDS_";" I D'[";IX;",D'[";IXE",D'[";IXIE" Q
. . . S DIDENT(-5)=1
. . S DIFLAGS=DIFLAGS_4
. . I DIFLAGS["O",DIFLAGS["X" S DIFLAGS=$TR(DIFLAGS,"O")
. . S DIFLAGS=DIFLAGS_"t"
. . ;
I2 . . ; 2.2. Validate Value (DIVALUE)
. . ;
. . I DIFLAGS'["l" N DIERRM D I DIFAIL D ERR^DICF4(202,"","","",DIERRM) Q
. . . S DIERRM="Lookup values"
. . . I $G(DIVALUE(1))="" S DIVALUE(1)=$G(DIVALUE)
. . . N I,DIEND S DIFAIL=1,DIEND=$O(DIVALUE(999999),-1)
. . . F I=1:1:DIEND S DIVALUE(I)=$G(DIVALUE(I)) I DIVALUE(I)]"" S DIFAIL=$$BADVAL(DIVALUE(I)) Q:DIFAIL
. ;
I3 . ; 2.3. Validate Target_Root (DILIST) & Init Target Array
. ;
. S DILIST=$G(DILIST)
. I DILIST'="",DIFLAGS'["l" D
. . I DIFLAGS'["p" K @DILIST
. . I DIFLAGS'["f" S DILIST=$NA(@DILIST@("DILIST"))
. I DILIST="" S DILIST="^TMP(""DILIST"",$J)" K @DILIST
. ;
I4 . ; 2.4. Validate File (DIFILE), IENS (DIFIEN), & Screen (DISCREEN)
. ;
. D:DIFLAGS'["v"&(DIFLAGS'["l") FILE^DICUF(.DIFILE,.DIFIEN,DIFLAGS)
. I $G(DIERR) S DIFAIL=1 Q
. D SCREEN^DICUF(DIFLAGS,.DIFILE,.DISCREEN)
. D DA^DILF(DIFIEN,.DIEN)
. ;
I5 . ; 2.5. Validate Fields (DIFIELDS)
. ;
. S DIFIELDS=$G(DIFIELDS)
. ;
I6 . ; 2.6. Validate Flags (DIFLAGS), part 3 of 3
. ;
. I DIFLAGS'["p",DIFLAGS'["l" D Q:DIFAIL
. . I $TR(DIFLAGS,"ABCKMOPQSUXfglpqtv4E")'="" S DIFAIL=1 D Q ;GFT
. . . D ERR^DICF4(301,"","","",$TR(DIFLAGS,"fglpqtv4"))
. ;
I7 . ; 2.7. Validate Indexes (DIFORCE), Set Starting Index (DINDEX)
. ;
. I DIFLAGS'["l" D Q:DIFAIL
. . S DIFORCE=$G(DIFORCE),DIFORCE(1)=1
. . I "*"[DIFORCE D
. . . I DIFLAGS["M" S DIFORCE=0,DIFORCE(0)="*" Q
. . . S DIFORCE(0)=$$DINDEX^DICL(DIFILE,DIFLAGS),DIFORCE=1 Q
. . E D I DIFAIL D ERR^DICF4(202,"","","","Indexes") Q
. . . I $P(DIFORCE,U)="" S DIFAIL=1 Q
. . . S DIFORCE(0)=DIFORCE,DIFORCE=1
. . . I $P(DIFORCE(0),U,2)]"",DIFLAGS'["M" S DIFLAGS=DIFLAGS_"M"
. . I DIFORCE S DINDEX=$P(DIFORCE(0),U) Q
. . S DINDEX=$$DINDEX^DICL(DIFILE,DIFLAGS) Q
. ;
I8 . ; 2.8. Validate Number (DINUMBER) & Identifier (DIWRITE)
. ;
. I DIFLAGS'["p",DIFLAGS'["l" D Q:DIFAIL
. . S DINUMBER=$S($G(DINUMBER):DINUMBER,1:"*")
. . I DINUMBER'="*" D Q:DIFAIL
. . . I DINUMBER\1=DINUMBER,DINUMBER>0 Q
. . . S DIFAIL=1 D ERR^DICF4(202,"","","","Number")
. S DIWRITE=$G(DIWRITE)
;
I9 ; 2.9. Init Map (DIDENT(-3)), Window (DIDENT(-1)), & Done (DIOUT)
;
I DIFLAGS["P" S DIDENT(-3)=""
S DIDENT(-1,"MAX")=DINUMBER
S DIDENT(-1,"MORE?")=0
S DIDENT(-1,"JUST LOOKING")=0
N DIOUT S DIOUT=0
;
HOOK75 ; 3. Process Pre-lookup Transform
;
N DIHOOK75
S DIHOOK75=$G(^DD(DIFILE,.01,7.5))
I DIHOOK75'="",DIVALUE(1)]"",DIVALUE(1)'?."?",'$O(DIVALUE(1)),DIFLAGS'["l" D I DIOUT D CLOSE Q
.N DIC D ;I DIFLAGS["p" N DIC D
. . S DIC=DIFILE,DIC(0)=$TR(DIFLAGS,"2^fglpqtv4") Q
. N %,D,X,Y,Y1
. S X=DIVALUE(1),D=DINDEX
. M Y=DIEN S Y="",Y1=DIFIEN
. X DIHOOK75 I '$D(X)!$G(DIERR) S DIOUT=1 D:$G(DIERR) Q
. . S %=$$EZBLD^DIALOG(8090) ;Pre-lookup transform (7.5 node)
. . D ERR^DICF4(120,DIFILE,"",.01,%)
. S DIVALUE(1)=X,DIOUT=$$BADVAL(DIVALUE(1)) Q:DIOUT
. I $G(DIC("S"))'="" S DISCREEN("S")=DIC("S") ;DIHOOK MAY HAVE SET THIS
. I $G(DIC("V"))'="" S (DISCREEN("V"),DISCREEN("V",1))=DIC("V") ;...OR THIS
;
LOOKUP ; 4. Finder Main Lookup Code
;
I DIFLAGS'["l" D I DIOUT!($G(DIERR)) D CLOSE Q
. D INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,"",.DIVALUE,DINUMBER,.DISCREEN,DILIST,.DIOUT) Q
I '$D(DINDEX("MAXSUB")) D
. S DINDEX("MAXSUB")=$P($G(^DD("OS",+$G(^DD("OS")),0)),U,7)
. I DINDEX("MAXSUB") S DINDEX("MAXSUB")=DINDEX("MAXSUB")-13 Q
. S DINDEX("MAXSUB")=50
I $D(DISCREEN("V")) D VPDATA^DICUF(.DINDEX,.DISCREEN)
I (DINDEX'="#")!($O(DIVALUE(1))) D CHKVAL1^DIC0(DINDEX("#"),.DIVALUE,DIFLAGS) I $G(DIERR) D CLOSE Q
I DIFLAGS'["f" D I $G(DIERR) D CLOSE Q
. D IDENTS^DICU1(DIFLAGS,.DIFILE,DIFIELDS,DIWRITE,.DIDENT,.DINDEX)
I DIFLAGS'["p",DIFLAGS'["l" D I DIOUT!($G(DIERR)) D CLOSE Q
. N I F I=2:1:DINDEX("#") Q:$G(DIVALUE(I))]""
. Q:$G(DIVALUE(I))]""
. D SPECIAL^DICF1(.DIFILE,.DIEN,DIFIEN,DIFLAGS,DIVALUE(1),.DINDEX,.DISCREEN,.DIDENT,.DIOUT,.DILIST)
I DIFLAGS["t" D XFORM^DICF1(.DIFLAGS,.DIVALUE,.DISCREEN,.DINDEX)
I DIFLAGS'["X" D ; unless we are doing exact matches, also load FROM
. D BACKFROM^DICF1(.DIVALUE,.DINDEX) ; values for backward traversal
I DINDEX("#")>1,DIVALUE(1)="" N S M S=DISCREEN N DISCREEN M DISCREEN=S K S D
. I DIFIELDS["IX",DIFIELDS'["-IX" Q
. N DISAVMAX S DISAVMAX=DINDEX("MAXSUB")
. D ALTIDX^DICF0(.DINDEX,.DIFILE,.DIVALUE,.DISCREEN,DINUMBER)
. S DINDEX("MAXSUB")=DISAVMAX
D CHKALL^DICF2(.DIFILE,.DIEN,DIFIEN,.DIFLAGS,.DIVALUE,.DISCREEN,DINUMBER,.DIFORCE,.DINDEX,.DIDENT,.DILIST,.DIC,.DIY,.DIYX)
D CLOSE
;
QUIT ; end of $$FIND/FINDX/INPUT/HOOK75/LOOKUP
;
;
BADVAL(DIVALUE) ; Validate a Lookup Value
;
I "^"[DIVALUE Q 1
I DIVALUE'?.ANP D ERR^DICF4(204,"","","",DIVALUE) Q 1
;
QUIT 0 ; end of $$BADVAL
;
;
CLOSE ; Cleanup before Exiting Finder
;
I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
I DICLERR'=""!$G(DIERR) D
. I DIFLAGS["l",+DIERR=1 Q
. S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
I $G(DIERR) D Q
. Q:$G(DILIST)="" K @DILIST@("B") Q
I DIFLAGS["p" S @DILIST=DIDENT(-1) Q
Q:DIFLAGS["l"
S @DILIST@(0)=DIDENT(-1)_U_DIDENT(-1,"MAX")_U_DIDENT(-1,"MORE?")_U_$S(DIFLAGS[2:"H",1:"")
I DIFLAGS["P" S @DILIST@(0,"MAP")=$G(DIDENT(-3))
E D SETMAP^DICL1(.DIDENT,DILIST)
K @DILIST@("B")
;
QUIT ; end of CLOSE
;
;
; Error messages:
; 120 The previous error occurred when performin
; 202 The input parameter that identifies the |1
; 204 The input value contains control character
; 301 The passed flag(s) '|1|' are unknown or in
; 8090 Pre-lookup transform (7.5 node)
; 8093 Too many lookup values for this index.
; 8094 Not enough lookup values provided for an e
; 8095 Only one compound index allowed on a looku
;
;
EOR ; end of routine DICF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICF 7396 printed Dec 13, 2024@02:45:59 Page 2
DICF ;VEN/TOAD,SF/TKW - Lookup: Finder, Part 1 (Main) ;1/24/13 3:51pm
+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 ;
+8 ; Contents
+9 ;
+10 ; $$FIND/FINDX/INPUT/HOOK75/LOOKUP: Finder Implementation
+11 ; $$BADVAL: Validate a Lookup Value
+12 ; CLOSE: Cleanup before Exiting Finder
+13 ;
+14 ;
FIND(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DIVALUE,DINUMBER,DIFORCE,DISCREEN,DIWRITE,DILIST,DIMSGA,DINDEX,DIC,DIY,DIYX) ;
+1 ; Finder Implementation [internal use only]
+2 ;
FINDX ; 1. Finder Pre-initialization [from FIND or FIND^DIC]
+1 ;
+2 IF '$DATA(DIQUIET)
IF $GET(DIC(0))'["E"
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 DIDENT
SET DIDENT(-1)=+$GET(DILIST("C"))
+6 ;
INPUT ; 2. Validate Input Parameters
+1 ;
+2 NEW DIEN
MERGE DIEN=DIVALUE
NEW DIVALUE
MERGE DIVALUE=DIEN
KILL DIEN
+3 ; Validate Flags (DIFLAGS), part 1 of 3
SET DIFLAGS=$GET(DIFLAGS)
+4 IF DIFLAGS'["l"
NEW DINDEX
SET DINDEX("WAY")=1
+5 ;
+6 NEW DIFAIL
SET DIFAIL=0
+7 Begin DoDot:1
+8 ;
I1 ; 2.1. Validate Flags (DIFLAGS), part 2 of 3
+1 ;
+2 IF DIFLAGS["p"
SET DIFLAGS=DIFLAGS_"f"
+3 IF DIFLAGS'["p"
Begin DoDot:2
+4 IF $GET(DIFIELDS)["IX"
IF DIFIELDS'["-IX"
Begin DoDot:3
+5 NEW D
SET D=";"_DIFIELDS_";"
IF D'[";IX;"
IF D'[";IXE"
IF D'[";IXIE"
QUIT
+6 SET DIDENT(-5)=1
End DoDot:3
+7 SET DIFLAGS=DIFLAGS_4
+8 IF DIFLAGS["O"
IF DIFLAGS["X"
SET DIFLAGS=$TRANSLATE(DIFLAGS,"O")
+9 SET DIFLAGS=DIFLAGS_"t"
+10 ;
I2 ; 2.2. Validate Value (DIVALUE)
+1 ;
+2 IF DIFLAGS'["l"
NEW DIERRM
Begin DoDot:3
+3 SET DIERRM="Lookup values"
+4 IF $GET(DIVALUE(1))=""
SET DIVALUE(1)=$GET(DIVALUE)
+5 NEW I,DIEND
SET DIFAIL=1
SET DIEND=$ORDER(DIVALUE(999999),-1)
+6 FOR I=1:1:DIEND
SET DIVALUE(I)=$GET(DIVALUE(I))
IF DIVALUE(I)]""
SET DIFAIL=$$BADVAL(DIVALUE(I))
if DIFAIL
QUIT
End DoDot:3
IF DIFAIL
DO ERR^DICF4(202,"","","",DIERRM)
QUIT
End DoDot:2
if DIFAIL
QUIT
+7 ;
I3 ; 2.3. Validate Target_Root (DILIST) & Init Target Array
+1 ;
+2 SET DILIST=$GET(DILIST)
+3 IF DILIST'=""
IF DIFLAGS'["l"
Begin DoDot:2
+4 IF DIFLAGS'["p"
KILL @DILIST
+5 IF DIFLAGS'["f"
SET DILIST=$NAME(@DILIST@("DILIST"))
End DoDot:2
+6 IF DILIST=""
SET DILIST="^TMP(""DILIST"",$J)"
KILL @DILIST
+7 ;
I4 ; 2.4. Validate File (DIFILE), IENS (DIFIEN), & Screen (DISCREEN)
+1 ;
+2 if DIFLAGS'["v"&(DIFLAGS'["l")
DO FILE^DICUF(.DIFILE,.DIFIEN,DIFLAGS)
+3 IF $GET(DIERR)
SET DIFAIL=1
QUIT
+4 DO SCREEN^DICUF(DIFLAGS,.DIFILE,.DISCREEN)
+5 DO DA^DILF(DIFIEN,.DIEN)
+6 ;
I5 ; 2.5. Validate Fields (DIFIELDS)
+1 ;
+2 SET DIFIELDS=$GET(DIFIELDS)
+3 ;
I6 ; 2.6. Validate Flags (DIFLAGS), part 3 of 3
+1 ;
+2 IF DIFLAGS'["p"
IF DIFLAGS'["l"
Begin DoDot:2
+3 ;GFT
IF $TRANSLATE(DIFLAGS,"ABCKMOPQSUXfglpqtv4E")'=""
SET DIFAIL=1
Begin DoDot:3
+4 DO ERR^DICF4(301,"","","",$TRANSLATE(DIFLAGS,"fglpqtv4"))
End DoDot:3
QUIT
End DoDot:2
if DIFAIL
QUIT
+5 ;
I7 ; 2.7. Validate Indexes (DIFORCE), Set Starting Index (DINDEX)
+1 ;
+2 IF DIFLAGS'["l"
Begin DoDot:2
+3 SET DIFORCE=$GET(DIFORCE)
SET DIFORCE(1)=1
+4 IF "*"[DIFORCE
Begin DoDot:3
+5 IF DIFLAGS["M"
SET DIFORCE=0
SET DIFORCE(0)="*"
QUIT
+6 SET DIFORCE(0)=$$DINDEX^DICL(DIFILE,DIFLAGS)
SET DIFORCE=1
QUIT
End DoDot:3
+7 IF '$TEST
Begin DoDot:3
+8 IF $PIECE(DIFORCE,U)=""
SET DIFAIL=1
QUIT
+9 SET DIFORCE(0)=DIFORCE
SET DIFORCE=1
+10 IF $PIECE(DIFORCE(0),U,2)]""
IF DIFLAGS'["M"
SET DIFLAGS=DIFLAGS_"M"
End DoDot:3
IF DIFAIL
DO ERR^DICF4(202,"","","","Indexes")
QUIT
+11 IF DIFORCE
SET DINDEX=$PIECE(DIFORCE(0),U)
QUIT
+12 SET DINDEX=$$DINDEX^DICL(DIFILE,DIFLAGS)
QUIT
End DoDot:2
if DIFAIL
QUIT
+13 ;
I8 ; 2.8. Validate Number (DINUMBER) & Identifier (DIWRITE)
+1 ;
+2 IF DIFLAGS'["p"
IF DIFLAGS'["l"
Begin DoDot:2
+3 SET DINUMBER=$SELECT($GET(DINUMBER):DINUMBER,1:"*")
+4 IF DINUMBER'="*"
Begin DoDot:3
+5 IF DINUMBER\1=DINUMBER
IF DINUMBER>0
QUIT
+6 SET DIFAIL=1
DO ERR^DICF4(202,"","","","Number")
End DoDot:3
if DIFAIL
QUIT
End DoDot:2
if DIFAIL
QUIT
+7 SET DIWRITE=$GET(DIWRITE)
End DoDot:1
IF DIFAIL
DO CLOSE
QUIT
+8 ;
I9 ; 2.9. Init Map (DIDENT(-3)), Window (DIDENT(-1)), & Done (DIOUT)
+1 ;
+2 IF DIFLAGS["P"
SET DIDENT(-3)=""
+3 SET DIDENT(-1,"MAX")=DINUMBER
+4 SET DIDENT(-1,"MORE?")=0
+5 SET DIDENT(-1,"JUST LOOKING")=0
+6 NEW DIOUT
SET DIOUT=0
+7 ;
HOOK75 ; 3. Process Pre-lookup Transform
+1 ;
+2 NEW DIHOOK75
+3 SET DIHOOK75=$GET(^DD(DIFILE,.01,7.5))
+4 IF DIHOOK75'=""
IF DIVALUE(1)]""
IF DIVALUE(1)'?."?"
IF '$ORDER(DIVALUE(1))
IF DIFLAGS'["l"
Begin DoDot:1
+5 ;I DIFLAGS["p" N DIC D
NEW DIC
Begin DoDot:2
+6 SET DIC=DIFILE
SET DIC(0)=$TRANSLATE(DIFLAGS,"2^fglpqtv4")
QUIT
End DoDot:2
+7 NEW %,D,X,Y,Y1
+8 SET X=DIVALUE(1)
SET D=DINDEX
+9 MERGE Y=DIEN
SET Y=""
SET Y1=DIFIEN
+10 XECUTE DIHOOK75
IF '$DATA(X)!$GET(DIERR)
SET DIOUT=1
if $GET(DIERR)
Begin DoDot:2
+11 ;Pre-lookup transform (7.5 node)
SET %=$$EZBLD^DIALOG(8090)
+12 DO ERR^DICF4(120,DIFILE,"",.01,%)
End DoDot:2
QUIT
+13 SET DIVALUE(1)=X
SET DIOUT=$$BADVAL(DIVALUE(1))
if DIOUT
QUIT
+14 ;DIHOOK MAY HAVE SET THIS
IF $GET(DIC("S"))'=""
SET DISCREEN("S")=DIC("S")
+15 ;...OR THIS
IF $GET(DIC("V"))'=""
SET (DISCREEN("V"),DISCREEN("V",1))=DIC("V")
End DoDot:1
IF DIOUT
DO CLOSE
QUIT
+16 ;
LOOKUP ; 4. Finder Main Lookup Code
+1 ;
+2 IF DIFLAGS'["l"
Begin DoDot:1
+3 DO INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,"",.DIVALUE,DINUMBER,.DISCREEN,DILIST,.DIOUT)
QUIT
End DoDot:1
IF DIOUT!($GET(DIERR))
DO CLOSE
QUIT
+4 IF '$DATA(DINDEX("MAXSUB"))
Begin DoDot:1
+5 SET DINDEX("MAXSUB")=$PIECE($GET(^DD("OS",+$GET(^DD("OS")),0)),U,7)
+6 IF DINDEX("MAXSUB")
SET DINDEX("MAXSUB")=DINDEX("MAXSUB")-13
QUIT
+7 SET DINDEX("MAXSUB")=50
End DoDot:1
+8 IF $DATA(DISCREEN("V"))
DO VPDATA^DICUF(.DINDEX,.DISCREEN)
+9 IF (DINDEX'="#")!($ORDER(DIVALUE(1)))
DO CHKVAL1^DIC0(DINDEX("#"),.DIVALUE,DIFLAGS)
IF $GET(DIERR)
DO CLOSE
QUIT
+10 IF DIFLAGS'["f"
Begin DoDot:1
+11 DO IDENTS^DICU1(DIFLAGS,.DIFILE,DIFIELDS,DIWRITE,.DIDENT,.DINDEX)
End DoDot:1
IF $GET(DIERR)
DO CLOSE
QUIT
+12 IF DIFLAGS'["p"
IF DIFLAGS'["l"
Begin DoDot:1
+13 NEW I
FOR I=2:1:DINDEX("#")
if $GET(DIVALUE(I))]""
QUIT
+14 if $GET(DIVALUE(I))]""
QUIT
+15 DO SPECIAL^DICF1(.DIFILE,.DIEN,DIFIEN,DIFLAGS,DIVALUE(1),.DINDEX,.DISCREEN,.DIDENT,.DIOUT,.DILIST)
End DoDot:1
IF DIOUT!($GET(DIERR))
DO CLOSE
QUIT
+16 IF DIFLAGS["t"
DO XFORM^DICF1(.DIFLAGS,.DIVALUE,.DISCREEN,.DINDEX)
+17 ; unless we are doing exact matches, also load FROM
IF DIFLAGS'["X"
Begin DoDot:1
+18 ; values for backward traversal
DO BACKFROM^DICF1(.DIVALUE,.DINDEX)
End DoDot:1
+19 IF DINDEX("#")>1
IF DIVALUE(1)=""
NEW S
MERGE S=DISCREEN
NEW DISCREEN
MERGE DISCREEN=S
KILL S
Begin DoDot:1
+20 IF DIFIELDS["IX"
IF DIFIELDS'["-IX"
QUIT
+21 NEW DISAVMAX
SET DISAVMAX=DINDEX("MAXSUB")
+22 DO ALTIDX^DICF0(.DINDEX,.DIFILE,.DIVALUE,.DISCREEN,DINUMBER)
+23 SET DINDEX("MAXSUB")=DISAVMAX
End DoDot:1
+24 DO CHKALL^DICF2(.DIFILE,.DIEN,DIFIEN,.DIFLAGS,.DIVALUE,.DISCREEN,DINUMBER,.DIFORCE,.DINDEX,.DIDENT,.DILIST,.DIC,.DIY,.DIYX)
+25 DO CLOSE
+26 ;
+27 ; end of $$FIND/FINDX/INPUT/HOOK75/LOOKUP
QUIT
+28 ;
+29 ;
BADVAL(DIVALUE) ; Validate a Lookup Value
+1 ;
+2 IF "^"[DIVALUE
QUIT 1
+3 IF DIVALUE'?.ANP
DO ERR^DICF4(204,"","","",DIVALUE)
QUIT 1
+4 ;
+5 ; end of $$BADVAL
QUIT 0
+6 ;
+7 ;
CLOSE ; Cleanup before Exiting Finder
+1 ;
+2 IF $GET(DIMSGA)'=""
DO CALLOUT^DIEFU(DIMSGA)
+3 IF DICLERR'=""!$GET(DIERR)
Begin DoDot:1
+4 IF DIFLAGS["l"
IF +DIERR=1
QUIT
+5 SET DIERR=$GET(DIERR)+DICLERR_U_($PIECE($GET(DIERR),U,2)+$PIECE(DICLERR,U,2))
End DoDot:1
+6 IF $GET(DIERR)
Begin DoDot:1
+7 if $GET(DILIST)=""
QUIT
KILL @DILIST@("B")
QUIT
End DoDot:1
QUIT
+8 IF DIFLAGS["p"
SET @DILIST=DIDENT(-1)
QUIT
+9 if DIFLAGS["l"
QUIT
+10 SET @DILIST@(0)=DIDENT(-1)_U_DIDENT(-1,"MAX")_U_DIDENT(-1,"MORE?")_U_$SELECT(DIFLAGS[2:"H",1:"")
+11 IF DIFLAGS["P"
SET @DILIST@(0,"MAP")=$GET(DIDENT(-3))
+12 IF '$TEST
DO SETMAP^DICL1(.DIDENT,DILIST)
+13 KILL @DILIST@("B")
+14 ;
+15 ; end of CLOSE
QUIT
+16 ;
+17 ;
+18 ; Error messages:
+19 ; 120 The previous error occurred when performin
+20 ; 202 The input parameter that identifies the |1
+21 ; 204 The input value contains control character
+22 ; 301 The passed flag(s) '|1|' are unknown or in
+23 ; 8090 Pre-lookup transform (7.5 node)
+24 ; 8093 Too many lookup values for this index.
+25 ; 8094 Not enough lookup values provided for an e
+26 ; 8095 Only one compound index allowed on a looku
+27 ;
+28 ;
EOR ; end of routine DICF
