Return to DICF3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Initial revision

DICF3	;SEA/TOAD-VA FileMan: Finder, Part 3 (One Index) ;11/3/94  16:08 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
CHKONE(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
	; CHKALL--check one index for possible matches
	; proc, DIFILE, DIFLAGS, & DIROOT by value
	N DIXFORM S DIXFORM=0
	N DIBEFORE S DIBEFORE=DICOUNT
	N DIEXTRNL,DITRY F  D  Q:DIXFORM=""
	. S DIXFORM=$O(@DILIST("LVA")@("V",DIXFORM)) I DIXFORM="" Q
	. S DIVALUE=@DILIST("LVA")@("V",DIXFORM)
	. S DISCREEN=$G(@DILIST("LVA")@("S",DIXFORM))
	. I DISCREEN="" S DISCREEN=@DILIST("LVA")@("S")
C1	. S DITRY=1
	. I DITRY D
	. . D EXACT(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
	. . I DIFLAGS["q" S DIXFORM="" Q
	. . I DIFLAGS["X" Q
	. . I DINDEX(0,"TYPE")["P" Q
	. . I DINDEX(0,"TYPE")["D",DIVALUE?.NP,+DIVALUE=DIVALUE D  Q:'DIEXTRNL
C2	. . . S DIEXTRNL=$G(@DILIST("LVA")@("V",DIXFORM,1))
	. . D PARTIAL(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
	. . I DIFLAGS["q" S DIXFORM=""
	; S DIVALUE=@DILIST("SAVE")@("V")
	I DICOUNT=DIBEFORE,$O(@DIROOT@(DINDEX,""))="",$O(@DIROOT@(0)) D  Q
	. D ERR^DICF6(420,DIFILE,"","",DINDEX)
	Q
	
PARTIAL(DIFILE,DIEN,DIFLAGS,DIROOT,DIPART,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
	; CHKONE--return the list of partial matches to DIVALUE in DINDEX
	; proc, DIVALUE, DICOUNT, DISCREEN, DIDENT by reference
	N DIOUT S DIOUT=0
	N DIVALUE S DIVALUE=DIPART
	N DIMORE S DIMORE=+DIPART=DIPART I DIMORE D MORE I DIOUT Q
	F  D  Q:DIOUT
	. S DIVALUE=$O(@DIROOT@(DINDEX,DIVALUE))
	. D  I DIOUT Q:'DIMORE  D MORE D  Q:DIOUT
	. . I DIPART'=$E(DIVALUE,1,$L(DIPART)) S DIOUT=1 Q
	. D EXACT(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
	. I DIFLAGS["q" S DIOUT=1 Q
	Q
	
MORE	
	; PARTIAL--continue numeric partial down into string numerics
	S DIMORE=0,DIOUT=0
	S DIVALUE=DIPART_" "
	S DIVALUE=$O(@DIROOT@(DINDEX,DIVALUE),-1)
	S DIOUT=$E($O(@DIROOT@(DINDEX,DIVALUE)),1,$L(DIPART))'=DIPART
	Q
	
EXACT(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
	; CHKONE/PARTIAL--consider selecting value DIVALUE
	; proc, DIEN, DIVALUE, DICOUNT, DISCREEN, DIDENT by reference
	N DIENTRY S DIENTRY="" F  D  I DIENTRY="" Q
	. S DIENTRY=$O(@DIROOT@(DINDEX,DIVALUE,DIENTRY)) Q:DIENTRY=""
	. S DIEN=DIENTRY_DIEN
	. D ENTRY(DIFILE,DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
	. S $P(DIEN,",")=""
	. I DIFLAGS["q" S DIENTRY="" Q
	Q
	
ENTRY(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
	; SPECIAL/EXACT--consider selecting entry # DIENTRY
	; proc, DIEN, DIVALUE, DICOUNT, DISCREEN, DIDENT by reference
	N DIENTRY S DIENTRY=$P(DIEN,",")
	N DINODE S DINODE=$G(@DIROOT@(DIENTRY,0))
	I '$$VMINUS9^DIEFU(DIFILE,DIEN) Q
	N DIKEY S DIKEY=$P(DINODE,"^") Q:DIKEY=""
	N DIFIELD,DIOUT S DIOUT=0
71	N DISCR F DISCR="DISCREEN","DISCREEN(""F"")" I @DISCR'="" D  Q:DIOUT
	. I $D(DINDEX(0,"GET")),'$D(DIFIELD) S @("DIFIELD="_DINDEX(0,"GET"))
	. N %
	. N D S D=DINDEX
	. N DIC S DIC=DIROOT("O")
	. S DIC(0)=$TR(DIFLAGS,"fglpqtuv")
	. N X S X=DIVALUE
	. N Y M Y=DIEN S Y=DIENTRY
	. N Y1 S Y1=$G(@DIROOT@(DIENTRY,0)),Y1=DIEN
	. I 1 X @DISCR ;***** NAKED *****
	. E  S DIOUT=1
	. I $G(DIERR) D
	. . S DIOUT=1,DIFLAGS=DIFLAGS_"q"
	. . N DICONTXT
	. . S DICONTXT=$S(DISCR["F":"Whole File Screen",1:"Screen Parameter")
	. . D ERR^DICF6(120,DIFILE,DIEN,"",DICONTXT)
	Q:DIOUT
72	I $D(@DILIST@("B",DIKEY,DIENTRY)) Q
	I 'DICOUNT("LOOK") D  Q:DIFLAGS["q"
	. S DICOUNT=DICOUNT+1
	. I DIFLAGS'["f" S @DILIST@(1,DICOUNT)=DIKEY,@DILIST@(2,DICOUNT)=DIENTRY
	. E  I DIFLAGS'["v" S @DILIST@(DICOUNT)=DIENTRY
	. E  S @DILIST@(DICOUNT)=DIENTRY_DIROOT("V")
	. S @DILIST@("B",DIKEY,DIENTRY)=""
	. I DIFLAGS'["f" D IDS^DICU2(DIFILE,.DIEN,.DIFLAGS,DIVALUE,.DIROOT,.DINDEX,.DICOUNT,.DIDENT,.DILIST) I $G(DIERR) S DIOUT=1,DIFLAGS=DIFLAGS_"q"
	E  S DICOUNT("MORE")=1
	I DICOUNT("MAX")="" Q
	I DICOUNT=DICOUNT("MAX") S DICOUNT("LOOK")=1
	I DICOUNT("MORE") S DIFLAGS=DIFLAGS_"q",DIOUT=1
	Q