Return to DICF3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICF3.m, revision 1.1

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