Return to DICF4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICF4	;SEA/TOAD-VA FileMan: Finder, Part 4 (No Index) ;10/14/94  12:29 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: UPRIGHT(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DICOUNT,DISCREEN,DIDENT,DILIST)	
    6: 	; FIND--manual selection engine, check upright file for matches
    7: 	; proc, DIFILE & DIROOT by value
    8: 	N DINDEX,DIFNODE,DIFPIECE,DIOUT
    9: 	I DIFLAGS["O" S DIFLAGS=DIFLAGS_"X"
   10: 	S DIDA=0,DIOUT=0
   11: 	D PREP(DIFILE,.DIFLAGS,.DIVALUE,.DINDEX,.DISCREEN,.DIOUT)
   12: 	I DIOUT Q
   13: 41	F  D  I DIOUT D DECIDE^DICF2(.DIFLAGS,.DINDEX,DICOUNT,.DIOUT) Q:DIOUT  S DIDA=0
   14: 	. S DIDA=$O(@DIROOT@(DIDA))
   15: 	. I 'DIDA S DIOUT=1 Q
   16: 	. S $P(DIEN,",")=DIDA
   17: 	. D CHECK(DIFILE,.DIEN,.DIFLAGS,.DIVALUE,.DIROOT,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
   18: 	. S $P(DIEN,",")=""
   19: 	. I DIFLAGS["q" S DIOUT=1 Q
   20: 	Q
   21: 	
   22: PREP(DIFILE,DIFLAGS,DIVALUE,DINDEX,DISCREEN,DIOUT)	
   23: 	; UPRIGHT--lookup .01 type, add transform values to DIVALUE
   24: 	; proc, DIFILE & DIFLAGS by value
   25: 	N DIFFLAG
   26: 	S DINDEX(0,"COUNT")=0
   27: 	S DINDEX(0,"DEF")=$G(^DD(DIFILE,.01,0))
   28: 51	I DINDEX(0,"DEF")="" S DIOUT=1 Q
   29: 	S DIFFLAG=$P(DINDEX(0,"DEF"),U,2)
   30: 	I DIFFLAG["P"!(DIFFLAG["V") S DIFLAGS=DIFLAGS_"p"
   31: 	S DINDEX(0,"TRANSFORM")=DIFFLAG'["F"&(DIFFLAG'["N")
   32: 	I 'DINDEX(0,"TRANSFORM") Q
   33: 	S DINDEX(0,"FIRST")=10
   34: 	S DINDEX(0,"LAST")=9
   35: 52	I DIFFLAG["D" D PREPD^DICF2(.DIVALUE,.DINDEX,.DISCREEN) Q
   36: 	I DIFFLAG["S" D PREPS^DICF6(DIFLAGS,.DIVALUE,.DINDEX,.DISCREEN) Q
   37: 	Q
   38: 	
   39: CHECK(DIFILE,DIEN,DIFLAGS,DIVALUE,DIROOT,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
   40: 	; UPRIGHT--check one record for possible matches
   41: 	; proc, DIFILE, DIFLAGS, & DIROOT by value
   42: 	N DIKEY,DITRY,DIXFORM
   43: 	S DIKEY=$P($G(@DIROOT@(+DIEN,0)),U)
   44: 	I DIKEY="" Q
   45: 	S DIXFORM=0
   46: 	F  D  I DIXFORM="" Q
   47: 	. S DIXFORM=$O(@DILIST("LVA")@("V")) I DIXFORM="" Q
   48: 	. S DIVALUE=@DILIST("LVA")@("V")
   49: 	. S DISCREEN=@DILIST("LVA")@("S")
   50: 	. S DITRY=1
   51: 	. I DIVALUE?.NP,+DIVALUE=DIVALUE S DITRY=DIFLAGS'["p"
   52: 	. I DITRY,$P(DIKEY,DIVALUE)="" D
   53: 	. . S DINDEX="#"
   54: 	. . D ENTRY^DICF3(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,DINDEX,.DICOUNT,.DISCREEN)
   55: 	. . I DIFLAGS["q" S DIXFORM="" Q
   56: 	Q
   57: 	
   58: SOUNDEX(DIVALUE)	
   59: 	; func, convert value to soundex value
   60: 	N DICODE S DICODE="01230129022455012623019202"
   61: 	N DISOUND S DISOUND=$C($A(DIVALUE)-(DIVALUE?1L.E*32))
   62: 	N DIPREV S DIPREV=$E(DICODE,$A(DIVALUE)-64)
   63: 	N DICHAR,DIPOS
   64: 	F DIPOS=2:1 S DICHAR=$E(DIVALUE,DIPOS) Q:","[DICHAR  D  Q:$L(DISOUND)=4
   65: 	. Q:DICHAR'?1A
   66: 	. N DITRANS S DITRANS=$E(DICODE,$A(DICHAR)-$S(DICHAR?1U:64,1:96))
   67: 	. Q:DITRANS=DIPREV  Q:DITRANS=9
   68: 	. S DIPREV=DITRANS
   69: 	. I DITRANS'=0 S DISOUND=DISOUND_DITRANS
   70: 	Q $E(DISOUND_"000",1,4)
   71: 	
   72: ISSNDX(DIFILE,DIFIELD,DINDEX)	
   73: 	; func, return whether DINDEX is a soundex index
   74: 	N DIDEF,DIEN,DINAME S DIDEF="",DIEN=0
   75: 	F  S DIEN=$O(^DD(DIFILE,DIFIELD,1,DIEN)) Q:'DIEN  D  Q:DINDEX=DINAME
   76: 	. S DIDEF=$G(^DD(DIFILE,DIFIELD,1,DIEN,0))
   77: 	. S DINAME=$P(DIDEF,U,2)
   78: 	Q $P(DIDEF,U,3)="SOUNDEX"