Return to DICF4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DICF4	;SEA/TOAD-VA FileMan: Finder, Part 4 (No Index) ;10/14/94  12:29 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
UPRIGHT(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DICOUNT,DISCREEN,DIDENT,DILIST)	
	; FIND--manual selection engine, check upright file for matches
	; proc, DIFILE & DIROOT by value
	N DINDEX,DIFNODE,DIFPIECE,DIOUT
	I DIFLAGS["O" S DIFLAGS=DIFLAGS_"X"
	S DIDA=0,DIOUT=0
	D PREP(DIFILE,.DIFLAGS,.DIVALUE,.DINDEX,.DISCREEN,.DIOUT)
	I DIOUT Q
41	F  D  I DIOUT D DECIDE^DICF2(.DIFLAGS,.DINDEX,DICOUNT,.DIOUT) Q:DIOUT  S DIDA=0
	. S DIDA=$O(@DIROOT@(DIDA))
	. I 'DIDA S DIOUT=1 Q
	. S $P(DIEN,",")=DIDA
	. D CHECK(DIFILE,.DIEN,.DIFLAGS,.DIVALUE,.DIROOT,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
	. S $P(DIEN,",")=""
	. I DIFLAGS["q" S DIOUT=1 Q
	Q
	
PREP(DIFILE,DIFLAGS,DIVALUE,DINDEX,DISCREEN,DIOUT)	
	; UPRIGHT--lookup .01 type, add transform values to DIVALUE
	; proc, DIFILE & DIFLAGS by value
	N DIFFLAG
	S DINDEX(0,"COUNT")=0
	S DINDEX(0,"DEF")=$G(^DD(DIFILE,.01,0))
51	I DINDEX(0,"DEF")="" S DIOUT=1 Q
	S DIFFLAG=$P(DINDEX(0,"DEF"),U,2)
	I DIFFLAG["P"!(DIFFLAG["V") S DIFLAGS=DIFLAGS_"p"
	S DINDEX(0,"TRANSFORM")=DIFFLAG'["F"&(DIFFLAG'["N")
	I 'DINDEX(0,"TRANSFORM") Q
	S DINDEX(0,"FIRST")=10
	S DINDEX(0,"LAST")=9
52	I DIFFLAG["D" D PREPD^DICF2(.DIVALUE,.DINDEX,.DISCREEN) Q
	I DIFFLAG["S" D PREPS^DICF6(DIFLAGS,.DIVALUE,.DINDEX,.DISCREEN) Q
	Q
	
CHECK(DIFILE,DIEN,DIFLAGS,DIVALUE,DIROOT,DINDEX,DICOUNT,DISCREEN,DIDENT,DILIST)	
	; UPRIGHT--check one record for possible matches
	; proc, DIFILE, DIFLAGS, & DIROOT by value
	N DIKEY,DITRY,DIXFORM
	S DIKEY=$P($G(@DIROOT@(+DIEN,0)),U)
	I DIKEY="" Q
	S DIXFORM=0
	F  D  I DIXFORM="" Q
	. S DIXFORM=$O(@DILIST("LVA")@("V")) I DIXFORM="" Q
	. S DIVALUE=@DILIST("LVA")@("V")
	. S DISCREEN=@DILIST("LVA")@("S")
	. S DITRY=1
	. I DIVALUE?.NP,+DIVALUE=DIVALUE S DITRY=DIFLAGS'["p"
	. I DITRY,$P(DIKEY,DIVALUE)="" D
	. . S DINDEX="#"
	. . D ENTRY^DICF3(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,DINDEX,.DICOUNT,.DISCREEN)
	. . I DIFLAGS["q" S DIXFORM="" Q
	Q
	
SOUNDEX(DIVALUE)	
	; func, convert value to soundex value
	N DICODE S DICODE="01230129022455012623019202"
	N DISOUND S DISOUND=$C($A(DIVALUE)-(DIVALUE?1L.E*32))
	N DIPREV S DIPREV=$E(DICODE,$A(DIVALUE)-64)
	N DICHAR,DIPOS
	F DIPOS=2:1 S DICHAR=$E(DIVALUE,DIPOS) Q:","[DICHAR  D  Q:$L(DISOUND)=4
	. Q:DICHAR'?1A
	. N DITRANS S DITRANS=$E(DICODE,$A(DICHAR)-$S(DICHAR?1U:64,1:96))
	. Q:DITRANS=DIPREV  Q:DITRANS=9
	. S DIPREV=DITRANS
	. I DITRANS'=0 S DISOUND=DISOUND_DITRANS
	Q $E(DISOUND_"000",1,4)
	
ISSNDX(DIFILE,DIFIELD,DINDEX)	
	; func, return whether DINDEX is a soundex index
	N DIDEF,DIEN,DINAME S DIDEF="",DIEN=0
	F  S DIEN=$O(^DD(DIFILE,DIFIELD,1,DIEN)) Q:'DIEN  D  Q:DINDEX=DINAME
	. S DIDEF=$G(^DD(DIFILE,DIFIELD,1,DIEN,0))
	. S DINAME=$P(DIDEF,U,2)
	Q $P(DIDEF,U,3)="SOUNDEX"