Return to DICF3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICF3	;SEA/TOAD-VA FileMan: Finder, Part 3 (One Index) ;11/3/94  16:08 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: CHKONE(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
    6: 	; CHKALL--check one index for possible matches
    7: 	; proc, DIFILE, DIFLAGS, & DIROOT by value
    8: 	N DIXFORM S DIXFORM=0
    9: 	N DIBEFORE S DIBEFORE=DICOUNT
   10: 	N DIEXTRNL,DITRY F  D  Q:DIXFORM=""
   11: 	. S DIXFORM=$O(@DILIST("LVA")@("V",DIXFORM)) I DIXFORM="" Q
   12: 	. S DIVALUE=@DILIST("LVA")@("V",DIXFORM)
   13: 	. S DISCREEN=$G(@DILIST("LVA")@("S",DIXFORM))
   14: 	. I DISCREEN="" S DISCREEN=@DILIST("LVA")@("S")
   15: C1	. S DITRY=1
   16: 	. I DITRY D
   17: 	. . D EXACT(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
   18: 	. . I DIFLAGS["q" S DIXFORM="" Q
   19: 	. . I DIFLAGS["X" Q
   20: 	. . I DINDEX(0,"TYPE")["P" Q
   21: 	. . I DINDEX(0,"TYPE")["D",DIVALUE?.NP,+DIVALUE=DIVALUE D  Q:'DIEXTRNL
   22: C2	. . . S DIEXTRNL=$G(@DILIST("LVA")@("V",DIXFORM,1))
   23: 	. . D PARTIAL(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
   24: 	. . I DIFLAGS["q" S DIXFORM=""
   25: 	; S DIVALUE=@DILIST("SAVE")@("V")
   26: 	I DICOUNT=DIBEFORE,$O(@DIROOT@(DINDEX,""))="",$O(@DIROOT@(0)) D  Q
   27: 	. D ERR^DICF6(420,DIFILE,"","",DINDEX)
   28: 	Q
   29: 	
   30: PARTIAL(DIFILE,DIEN,DIFLAGS,DIROOT,DIPART,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
   31: 	; CHKONE--return the list of partial matches to DIVALUE in DINDEX
   32: 	; proc, DIVALUE, DICOUNT, DISCREEN, DIDENT by reference
   33: 	N DIOUT S DIOUT=0
   34: 	N DIVALUE S DIVALUE=DIPART
   35: 	N DIMORE S DIMORE=+DIPART=DIPART I DIMORE D MORE I DIOUT Q
   36: 	F  D  Q:DIOUT
   37: 	. S DIVALUE=$O(@DIROOT@(DINDEX,DIVALUE))
   38: 	. D  I DIOUT Q:'DIMORE  D MORE D  Q:DIOUT
   39: 	. . I DIPART'=$E(DIVALUE,1,$L(DIPART)) S DIOUT=1 Q
   40: 	. D EXACT(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
   41: 	. I DIFLAGS["q" S DIOUT=1 Q
   42: 	Q
   43: 	
   44: MORE	
   45: 	; PARTIAL--continue numeric partial down into string numerics
   46: 	S DIMORE=0,DIOUT=0
   47: 	S DIVALUE=DIPART_" "
   48: 	S DIVALUE=$O(@DIROOT@(DINDEX,DIVALUE),-1)
   49: 	S DIOUT=$E($O(@DIROOT@(DINDEX,DIVALUE)),1,$L(DIPART))'=DIPART
   50: 	Q
   51: 	
   52: EXACT(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
   53: 	; CHKONE/PARTIAL--consider selecting value DIVALUE
   54: 	; proc, DIEN, DIVALUE, DICOUNT, DISCREEN, DIDENT by reference
   55: 	N DIENTRY S DIENTRY="" F  D  I DIENTRY="" Q
   56: 	. S DIENTRY=$O(@DIROOT@(DINDEX,DIVALUE,DIENTRY)) Q:DIENTRY=""
   57: 	. S DIEN=DIENTRY_DIEN
   58: 	. D ENTRY(DIFILE,DIEN,.DIFLAGS,.DIROOT,.DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
   59: 	. S $P(DIEN,",")=""
   60: 	. I DIFLAGS["q" S DIENTRY="" Q
   61: 	Q
   62: 	
   63: ENTRY(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
   64: 	; SPECIAL/EXACT--consider selecting entry # DIENTRY
   65: 	; proc, DIEN, DIVALUE, DICOUNT, DISCREEN, DIDENT by reference
   66: 	N DIENTRY S DIENTRY=$P(DIEN,",")
   67: 	N DINODE S DINODE=$G(@DIROOT@(DIENTRY,0))
   68: 	I '$$VMINUS9^DIEFU(DIFILE,DIEN) Q
   69: 	N DIKEY S DIKEY=$P(DINODE,"^") Q:DIKEY=""
   70: 	N DIFIELD,DIOUT S DIOUT=0
   71: 71	N DISCR F DISCR="DISCREEN","DISCREEN(""F"")" I @DISCR'="" D  Q:DIOUT
   72: 	. I $D(DINDEX(0,"GET")),'$D(DIFIELD) S @("DIFIELD="_DINDEX(0,"GET"))
   73: 	. N %
   74: 	. N D S D=DINDEX
   75: 	. N DIC S DIC=DIROOT("O")
   76: 	. S DIC(0)=$TR(DIFLAGS,"fglpqtuv")
   77: 	. N X S X=DIVALUE
   78: 	. N Y M Y=DIEN S Y=DIENTRY
   79: 	. N Y1 S Y1=$G(@DIROOT@(DIENTRY,0)),Y1=DIEN
   80: 	. I 1 X @DISCR ;***** NAKED *****
   81: 	. E  S DIOUT=1
   82: 	. I $G(DIERR) D
   83: 	. . S DIOUT=1,DIFLAGS=DIFLAGS_"q"
   84: 	. . N DICONTXT
   85: 	. . S DICONTXT=$S(DISCR["F":"Whole File Screen",1:"Screen Parameter")
   86: 	. . D ERR^DICF6(120,DIFILE,DIEN,"",DICONTXT)
   87: 	Q:DIOUT
   88: 72	I $D(@DILIST@("B",DIKEY,DIENTRY)) Q
   89: 	I 'DICOUNT("LOOK") D  Q:DIFLAGS["q"
   90: 	. S DICOUNT=DICOUNT+1
   91: 	. I DIFLAGS'["f" S @DILIST@(1,DICOUNT)=DIKEY,@DILIST@(2,DICOUNT)=DIENTRY
   92: 	. E  I DIFLAGS'["v" S @DILIST@(DICOUNT)=DIENTRY
   93: 	. E  S @DILIST@(DICOUNT)=DIENTRY_DIROOT("V")
   94: 	. S @DILIST@("B",DIKEY,DIENTRY)=""
   95: 	. I DIFLAGS'["f" D IDS^DICU2(DIFILE,.DIEN,.DIFLAGS,DIVALUE,.DIROOT,.DINDEX,.DICOUNT,.DIDENT,.DILIST) I $G(DIERR) S DIOUT=1,DIFLAGS=DIFLAGS_"q"
   96: 	E  S DICOUNT("MORE")=1
   97: 	I DICOUNT("MAX")="" Q
   98: 	I DICOUNT=DICOUNT("MAX") S DICOUNT("LOOK")=1
   99: 	I DICOUNT("MORE") S DIFLAGS=DIFLAGS_"q",DIOUT=1
  100: 	Q