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