Return to DICF4.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICF4.m, revision 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"