Return to DICF4.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICF4.m, revision 1.1.1.1

1.1       snw         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"