Return to DICF3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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